home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / func-menu.el.z / func-menu.el
Encoding:
Text File  |  1998-05-21  |  85.5 KB  |  2,311 lines

  1. ;;; func-menu.el         --- Jump to a function within a buffer.
  2. ;;;
  3. ;;; David Hughes <d.hughes@videonetworks.com>
  4. ;;; Last modified: David Hughes 13th January 1997
  5. ;;; Version: 2.45
  6. ;;; Keywords: tools, c, lisp
  7. ;;;
  8. ;;; This program is free software; you can redistribute it and/or modify
  9. ;;; it under the terms of the GNU General Public License as published by
  10. ;;; the Free Software Foundation; either version 2, or (at your option)
  11. ;;; any later version.
  12. ;;;
  13. ;;; This program is distributed in the hope that it will be useful,
  14. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;;; GNU General Public License for more details.
  17. ;;;
  18. ;;; You should have received a copy of the GNU General Public License
  19. ;;; along with this program; if not, write to the Free Software
  20. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21. ;;;
  22. ;;; Synched up with: Not in FSF.
  23. ;;;
  24. ;;; Installation:
  25. ;;; =============
  26. ;;; (require 'func-menu)
  27. ;;; (define-key global-map 'f8 'function-menu)
  28. ;;; (add-hook 'find-file-hooks 'fume-add-menubar-entry)
  29. ;;; (define-key global-map "\C-cl" 'fume-list-functions)
  30. ;;; (define-key global-map "\C-cg" 'fume-prompt-function-goto)
  31. ;;; (define-key global-map '(shift button3) 'mouse-function-menu)
  32. ;;; (define-key global-map '(meta  button1) 'fume-mouse-function-goto)
  33. ;;;
  34. ;;; Description:
  35. ;;; ============
  36. ;;; Suppose you have a file with a lot of functions in it. Well, this package
  37. ;;; makes it easy to jump to any of those functions. The names of the
  38. ;;; functions in the current buffer are automatically put into a popup menu,
  39. ;;; you select one of the function-names and the point is moved to that very
  40. ;;; function. The mark is pushed on the mark-ring, so you can easily go back
  41. ;;; to where you were. Alternatively, you can use enter the name of the
  42. ;;; desired function via the minibuffer which offers completing read input. In
  43. ;;; addition, the name of the function before point is optionally displayed in
  44. ;;; the modeline.
  45. ;;;
  46. ;;; Support for non X Window versions of Emacs:
  47. ;;; ===========================================
  48. ;;; This package can also be used for non X versions of Emacs. In this case,
  49. ;;; only modeline display and completing read input from the minibuffer are
  50. ;;; possible.
  51. ;;;
  52. ;;; Modes supported:
  53. ;;; ================
  54. ;;; Ada, Assembly, Bacis2, BibTex, C++, C, Dired, Ehdm, ELisp, FORTRAN, Ksh,
  55. ;;; Latex, Lelisp, Makefile, Maple, Modula2, Modula3, Outline, Pascal, Perl,
  56. ;;; Postscript, Prolog, PVS, Python, SGML, Scheme, Tcl, Verilog
  57. ;;;
  58. ;;; Acknowledgements:
  59. ;;; =================
  60. ;;;
  61. ;;; Fix to fume-function-name-regexp-c
  62. ;;; Jonathan Edwards <edwards@intranet.com>
  63. ;;;
  64. ;;; Speedup for fume-cc-inside-comment
  65. ;;; Peter Pezaris <pez@dwwc.com>
  66. ;;;
  67. ;;; Made menu placement more flexible
  68. ;;; Bob Weiner <weiner@altrasoft.com>
  69. ;;;
  70. ;;; Fortran90 regexp
  71. ;;; John Turner <turner@xdiv.lanl.gov>
  72. ;;;
  73. ;;; Patch to error trap in fume-rescan-buffer
  74. ;;; Andy Piper <andyp@parallax.co.uk>
  75. ;;;
  76. ;;; Java support
  77. ;;; Bob Weiner <weiner@altrasoft.com>
  78. ;;; Heddy Boubaker <boubaker@dgac.fr>
  79. ;;;
  80. ;;; Patch for fume-rescan-buffer{-trigger}
  81. ;;; Christoph Wedler <wedler@vivaldi.fmi.uni-passau.de>
  82. ;;;
  83. ;;; Patch for fume-tickle-f-to-b
  84. ;;; Michael Sperber <sperber@informatik.uni-tuebingen.de>
  85. ;;;
  86. ;;; Cleanup suggestions
  87. ;;; Jonathan Stigelman <stig@hackvan.com>
  88. ;;;
  89. ;;; Idea for jumping directly with a mouse click
  90. ;;; Marc Paquette <Marc.Paquette@Softimage.COM>
  91. ;;;
  92. ;;; Prolog mode additions based on functions for Postscript mode
  93. ;;; Laszlo Teleki <laszlo@ipb.uni-bonn.de>
  94. ;;;
  95. ;;; Idea for displaying function name in modeline
  96. ;;; Paul Filipski <filipski@blackhawk.com>
  97. ;;;
  98. ;;; Fame mode support
  99. ;;; Cooper Vertz <cooper@prod2.imsi.com>
  100. ;;;
  101. ;;; Made fume-match-find-next-function-name iterative, not recursive, to avoid
  102. ;;; blowing out the emacs stack on big files with lots of prototypes.
  103. ;;; Joe Marshall <jrm@odi.com>
  104. ;;;
  105. ;;; Verilog support
  106. ;;; Matt Sale <mdsale@icdc.delcoelect.com>
  107. ;;;
  108. ;;; Minibuffer interface & Pascal support
  109. ;;; Espen Skoglund <espensk@stud.cs.uit.no>
  110. ;;;
  111. ;;; Python support
  112. ;;; Shuichi Koga <skoga@virginia.edu>
  113. ;;;
  114. ;;; Maple support
  115. ;;; Luc Tancredi <Luc.Tancredi@sophia.inria.fr>
  116. ;;;
  117. ;;; Combined Tcl and C++ function finder
  118. ;;; Andy Piper <ajp@eng.cam.ac.uk>
  119. ;;;
  120. ;;; Perl Support
  121. ;;; Alex Rezinsky <alexr@msil.sps.mot.com>
  122. ;;; Michael Lamoureux <lamour@engin.umich.edu>
  123. ;;;
  124. ;;; Suggested mouse interface
  125. ;;; Raymond L. Toy <toy@soho.crd.ge.com>
  126. ;;;
  127. ;;; Dired support
  128. ;;; Improved modula support
  129. ;;; Numerous code cleanups
  130. ;;; Norbert Kiesel <norbert@i3.informatik.rwth-aachen.de>
  131. ;;;
  132. ;;; Makefile support
  133. ;;; Suggested multi-choice sublisting
  134. ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
  135. ;;;
  136. ;;; Suggestions for menubar entry
  137. ;;; Andy Piper <ajp@eng.cam.ac.uk>
  138. ;;;
  139. ;;; Ada support
  140. ;;; Scott Evans  <gse@ocsystems.com>
  141. ;;; Michael Polo <mikep@polo.mn.org> <mikep@cfsmo.honeywell.com>
  142. ;;;
  143. ;;; Scheme, BibTeX, Ehdm & PVS support
  144. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  145. ;;;
  146. ;;; Modula support
  147. ;;; Geoffrey Wyant <gwyant@cloyd.east.sun.com>
  148. ;;;
  149. ;;; SGML support; submenu indexing
  150. ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
  151. ;;;
  152. ;;; Extensions to fume-function-name-regexp-lisp
  153. ;;; Vladimir Alexiev <vladimir@cs.ualberta.ca>
  154. ;;; Kari Heinola <kph@dpe.fi>
  155. ;;; Milo A. Chan <chan@jpmorgan.com>
  156. ;;; Jack Repenning <jackr@step7.informix.com>
  157. ;;; Cedric Beust <Cedric.Beust@sophia.inria.fr>
  158. ;;; Joachim Krumnow <krumnow@srsir02.ext.sap-ag.de>
  159. ;;;
  160. ;;; ksh support
  161. ;;; Philippe Bondono <bondono@vnet.ibm.com>
  162. ;;;
  163. ;;; FORTRAN support
  164. ;;; Paul Emsley <paule@chem.gla.ac.uk>
  165. ;;; Raymond L. Toy <toy@soho.crd.ge.com>
  166. ;;; Richard Cognot <cognot@elfgrc.co.uk>
  167. ;;; Greg Sjaardema <gdsjaar@sandia.gov>
  168. ;;;
  169. ;;; Latex support
  170. ;;; Wolfgang Mettbach <wolle@uni-paderborn.de>
  171. ;;; Paolo Frasconi <paolo@mcculloch.ing.unifi.it>
  172. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  173. ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
  174. ;;;
  175. ;;; Assembly support
  176. ;;; Bob Weiner <weiner@altrasoft.com>
  177. ;;;
  178. ;;; Removal of cl dependencies
  179. ;;; Russell Ritchie <russell@gssec.bt.co.uk>
  180. ;;;
  181. ;;; C++ mode enhancemencements for func-menu
  182. ;;; Andy Piper      <ajp@eng.cam.ac.uk>
  183. ;;; Kevin R. Powell <powell@csl.ncsa.uiuc.edu>
  184. ;;; Mats Lidell     <mats.lidell@eua.ericsson.se>
  185. ;;; Mike Battaglia  <mbattagl@spd.dsccc.com>
  186. ;;; Oliver Schittko <schittko@fokus.gmd.de>
  187. ;;; Tom Murray      <tmurray@hpindck.cup.hp.com>
  188. ;;; Russell Ritchie <russell@gssec.bt.co.uk>
  189. ;;;
  190. ;;; Tcl mode additions for func-menu
  191. ;;; Andy Piper <ajp@eng.cam.ac.uk>
  192. ;;; Jean-Michel Augusto <augusto@eurecom.fr>
  193. ;;; Dr P.G. Sjoerdsma <pgs1002@esc.cam.ac.uk>
  194. ;;;
  195. ;;; Postscript mode additions for func-menu
  196. ;;; Leigh Klotz <klotz@adoc.xerox.com>
  197. ;;;
  198. ;;; Suggestions for popup menu positioning
  199. ;;; Marc Gemis <makke@wins.uia.ac.be>
  200. ;;;
  201. ;;; Original FSF package
  202. ;;; Ake Stenhoff <etxaksf@aom.ericsson.se>
  203.  
  204. ;;; Code
  205.  
  206. (eval-when-compile
  207.   (byte-compiler-options
  208.     (optimize t)
  209.     (warnings (- free-vars unresolved))))
  210.  
  211. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  212. ;;;;;;;;;;;;;;;;;;;;;;;;  Environment Initialisation  ;;;;;;;;;;;;;;;;;;;;;;
  213. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  214.  
  215. (defconst fume-version "2.45")
  216.  
  217. (defgroup fume nil
  218.   "Jump to a function within a buffer."
  219.   :tag "Func Menu"
  220.   :group 'tools
  221.   :group 'c
  222.   :group 'lisp)
  223.  
  224. (defconst fume-developer "David Hughes <d.hughes@videonetworks.com>")
  225.  
  226. (defun fume-about ()
  227.   (interactive)
  228.   (sit-for 0)
  229.   (display-message 'no-log
  230.      (format "Func-Menu version %s, ⌐ 1996 %s" fume-version fume-developer)))
  231.  
  232. (defconst fume-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
  233.  
  234. (defmacro fume-defvar-local (var value &optional doc)
  235.   "Defines SYMBOL as an advertised variable.
  236. Performs a defvar, then executes `make-variable-buffer-local' on
  237. the variable.  Also sets the `permanent-local' property, so that
  238. `kill-all-local-variables' (called by major-mode setting commands)
  239. won't destroy func-menu control variables."
  240.   (` (progn
  241.        (if (, doc)
  242.            (defvar (, var) (, value) (, doc))
  243.          (defvar (, var) (, value)))
  244.        (make-variable-buffer-local '(, var))
  245.        (put '(, var) 'permanent-local t))))
  246.  
  247. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  248. ;;;;;;;;  Backward compatibility hacks for older versions of XEmacs  ;;;;;;;
  249. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  250.  
  251. (or (fboundp 'defalias)
  252.     ;; poor man's defalias
  253.     (defun defalias (sym newdef)
  254.       "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.
  255. Associates the function with the current load file, if any."
  256.       (fset sym (symbol-function newdef))))
  257.  
  258. (or (fboundp 'selected-frame)
  259.     (defalias 'selected-frame 'selected-screen))
  260.  
  261. (if (fboundp 'locate-window-from-coordinates)
  262.     ;; Older versions of XEmacs need a more robust version of 'event-window'
  263.     (defun fume-event-window (event)
  264.       (or (event-window event)
  265.           (locate-window-from-coordinates
  266.            (selected-frame) (list (event-x event) (event-y event)))
  267.           (locate-window-from-coordinates
  268.            (selected-frame) (list (event-x event) (1- (event-y event))))))
  269.   ;; In post 19.11 versions of XEmacs 'event-window' now works acceptably
  270.   (defalias 'fume-event-window 'event-window))
  271.  
  272. (or (fboundp 'shrink-window-if-larger-than-buffer)
  273.     ;; Win-Emacs doesn't have this goodie
  274.     (defun shrink-window-if-larger-than-buffer (&optional window reqd-height)
  275.       "Shrink WINDOW to the smallest no of lines needed to display its buffer,
  276. or to optional REQUIRED-HEIGHT if and only if that is larger. Does nothing if
  277. the buffer contains more lines than the present window height."
  278.       (interactive)
  279.       (let* ((OriginalWindow (selected-window))
  280.          (TargetWindow (select-window (or window OriginalWindow))))
  281.     (or (one-window-p t)
  282.         (and reqd-height (>= reqd-height (window-height)))
  283.         (< (window-height) (1+ (count-lines (point-min) (point-max))))
  284.         (let ((calc-reqd-height
  285.            (if truncate-lines
  286.                (1+ (count-lines (point-min) (point-max)))
  287.              (save-excursion
  288.                (let ((count 0)
  289.                  linew
  290.                  (windw (window-width)))
  291.              (goto-char (point-min))
  292.              (while (not (eobp))
  293.                (setq linew (1+ (progn (end-of-line)
  294.                           (current-column)))
  295.                  count (+ count
  296.                       (/ linew windw)
  297.                       (min (% linew windw) 1)))
  298.                (beginning-of-line 2))
  299.              count)))))
  300.           (setq reqd-height (1+ (max calc-reqd-height
  301.                                          (1- window-min-height)
  302.                      (or reqd-height 0))))
  303.           (if (> (window-height) reqd-height)
  304.           (let* (wc spare bonus share wins shrunkwins)
  305.             (walk-windows
  306.              '(lambda (w)
  307.             (select-window w)
  308.             (if (or (eq w TargetWindow)
  309.                 (> (1+ (count-lines (point-min) (point-max)))
  310.                    (1- (window-height w))))
  311.                 (setq wins (cons w wins))
  312.               (if (= (1+ (count-lines (point-min) (point-max)))
  313.                  (1- (window-height w)))
  314.                   (setq shrunkwins (cons w shrunkwins)))))
  315.              'nomini)
  316.             (setq wc (1- (length wins))
  317.               spare (- (window-height TargetWindow) reqd-height)
  318.               share (if (> wc 0) (/ spare wc))
  319.               bonus (if (> wc 0) (% spare wc))
  320.               shrunkwins (if (zerop wc) nil shrunkwins)
  321.               wins (mapcar (function
  322.                     (lambda (w)
  323.                       (cons w (list
  324.                            (if (eq w TargetWindow)
  325.                                reqd-height
  326.                              (+ (window-height w)
  327.                             share
  328.                             (if (zerop bonus)
  329.                                 0
  330.                               (setq bonus
  331.                                 (1- bonus))
  332.                               1)))
  333.                            (window-start w)))))
  334.                        wins))
  335.             (let (ok (trys 2))
  336.               (while (and (not ok) (> trys 0))
  337.             (setq trys (1- trys))
  338.             (mapcar
  339.              (function
  340.               (lambda (info)
  341.                 (select-window (car info))
  342.                             (enlarge-window
  343.                              (- (car (cdr info)) (window-height)))))
  344.              wins)
  345.             (setq ok t)
  346.             (mapcar
  347.              (function
  348.               (lambda (info)
  349.                 (setq ok
  350.                   (and ok
  351.                        (<= (abs (- (car (cdr info))
  352.                            (window-height
  353.                             (car info))))
  354.                        1)))))
  355.              wins)))
  356.             (mapcar
  357.              (function
  358.               (lambda (info)
  359.             (select-window (car info))
  360.             (if (eq (car info) TargetWindow)
  361.                             (shrink-window
  362.                              (- (window-height TargetWindow) reqd-height)))
  363.             (set-window-start (car info) (car (cdr (cdr info))))))
  364.              wins)
  365.             (mapcar
  366.              (function
  367.               (lambda (w)
  368.             (select-window w)
  369.             (if (< (1+ (count-lines (point-min) (point-max)))
  370.                                (1- (window-height w)))
  371.                             (shrink-window-if-larger-than-buffer))))
  372.              shrunkwins)))))
  373.     (select-window OriginalWindow))))
  374.  
  375. (defconst fume-modeline-buffer-identification
  376.   (if (boundp 'modeline-buffer-identification)
  377.       'modeline-buffer-identification
  378.     'mode-line-buffer-identification))
  379.  
  380. (defconst fume-use-local-post-command-hook
  381.   (boundp 'local-post-command-hook))
  382.  
  383. (cond ((fboundp 'add-submenu)
  384.        (defconst fume-add-submenu 'add-submenu)
  385.        (defun fume-munge-menu-args (menu-name submenu before)
  386.          (list fume-menu-path (cons menu-name submenu) before)))
  387.       (t
  388.        (defconst fume-add-submenu 'add-menu)
  389.        (defun fume-munge-menu-args (menu-name submenu before)
  390.          (list fume-menu-path menu-name submenu before))))
  391.  
  392. (defun fume-add-submenu (menu-name submenu before)
  393.   (apply fume-add-submenu (fume-munge-menu-args menu-name submenu before)))
  394.  
  395. ;; this seems to really be `should I try to change the menubar'
  396. (defconst fume-not-tty
  397.   (or (featurep 'menubar)     ;; XEmacs
  398.       (featurep 'menu-bar)))  ;; GNU Emacs  
  399.  
  400. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  401. ;;;;;;;;;;;;;;;;;;;;;;;;;;  Customizable Variables  ;;;;;;;;;;;;;;;;;;;;;;;;
  402. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  403.  
  404. (defcustom fume-auto-position-popup t
  405.   "*Set to nil if you don't want the menu to appear in the corner of the window
  406. in which case it will track the mouse position instead."
  407.   :type 'boolean
  408.   :group 'fume)
  409.  
  410. (fume-defvar-local fume-display-in-modeline-p t
  411.   "*Set to nil if you don't want the function name appearing in the modeline.
  412. If your modeline is already full, then you can set this variable to something
  413. besides nil or t and the current function will replace the normal
  414. modeline-buffer-identification
  415.  
  416. Note, this is a buffer-local variable.")
  417.  
  418. (defvar fume-buffer-name "*Function List*"
  419.   "Name of buffer used to list functions when fume-list-functions called")
  420.  
  421. (defcustom fume-menubar-menu-name "Functions"
  422.   "*Set this to the string you want to appear in the menubar"
  423.   :type 'string
  424.   :group 'fume)
  425.  
  426. ;;; Bob Weiner <weiner@altrasoft.com>
  427. (defvar fume-menu-path nil
  428.   "Menubar menu under which the function menu should be installed.
  429. Nil means install it on the menubar itself.  Otherwise, it should be a list
  430. of strings, each string names a successively deeper menu under which the
  431. new menu should be located.")
  432.  
  433. (defcustom fume-menubar-menu-location "Buffers"
  434.   "*Set this nil if you want the menu to appear last on the menubar.
  435. Otherwise set this to the menu you want \"Functions\" to appear in front of."
  436.   :type '(choice (const :tag "Last" nil) (string :format "%v"))
  437.   :group 'fume)
  438.  
  439. (defcustom fume-max-items 24
  440.   "*Maximum number of elements in a function (sub)menu."
  441.   :type 'integer
  442.   :group 'fume)
  443.  
  444. (defcustom fume-fn-window-position 3
  445.   "*Number of lines from top of window at which to show function.
  446. If nil, display function start from the centre of the window."
  447.   :type '(choice (const :tag "Center" nil) integer)
  448.   :group 'fume)
  449.  
  450. (defcustom fume-index-method 3
  451.   "*Set this to the method number you want used.
  452.  
  453. Methods currently supported:
  454. 0 = if you want submenu names to be numbered
  455. 1 = if you want submenu range indicated by first character
  456. 2 = if you want submenu range indicated by first 12 characters
  457. 3 = if you want submenu range indicated by as many characters as needed"
  458.   :type '(radio (const :tag "Numbered" 0)
  459.         (const :tag "Indicated by first character" 1)
  460.         (const :tag "Indicated by first 12 characters" 2)
  461.         (const :tag "Indicated by as many characters as needed" 3))
  462.   :group 'fume)
  463.  
  464. (defcustom fume-scanning-message "Scanning buffer... (%3d%%)"
  465.   "*Set to nil if you don't want progress messages during manual scanning
  466. of the buffer."
  467.   :type '(choice (const :tag "None" nil) string)
  468.   :group 'fume)
  469.  
  470. (defcustom fume-rescanning-message nil
  471.   "*Set to non-nil if you want progress messages during automatic scanning
  472. of the buffer. For example \"Re-Scanning buffer...\""
  473.   :type '(choice (const :tag "None" nil) string)
  474.   :group 'fume)
  475.  
  476. (defvar fume-rescan-trigger-counter-buffer-size 10000
  477.   "Used to tune the frequency of automatic checks on the buffer.
  478. The function fume-rescan-buffer-trigger only works whenever the value of the
  479. variable fume-rescan-trigger-counter reaches zero, whereupon it gets reset to
  480. the maximum of a) buffer-size/fume-rescan-trigger-counter-buffer-size 
  481.             or b) fume-rescan-trigger-counter-min")
  482.  
  483. (defvar fume-rescan-trigger-counter-min 50
  484.   "Used to tune the frequency of automatic checks on the buffer.
  485. The function fume-rescan-buffer-trigger only works whenever the value of the
  486. variable fume-rescan-trigger-counter reaches zero, whereupon it gets reset to
  487. the maximum of a) buffer-size/fume-rescan-trigger-counter-buffer-size 
  488.             or b) fume-rescan-trigger-counter-min")
  489.  
  490. (fume-defvar-local
  491.  fume-sort-function 'fume-sort-by-name
  492.  "*The function to use for sorting the function menu.
  493.  
  494. Set this to nil if you don't want any sorting (faster).
  495. The items in the menu are then presented in the order they were found
  496. in the buffer.
  497.  
  498. The function should take two arguments and return T if the first
  499. element should come before the second.  The arguments are cons cells;
  500. (NAME . POSITION).  Look at 'fume-sort-by-name' for an example.")
  501.  
  502. (fume-defvar-local
  503.  fume-rescan-buffer-hook nil
  504.  "*Buffer local hook to call at the end of each buffer rescan")
  505.  
  506. ;;; This hook is provided for outl-mouse and must not be made buffer local as
  507. ;;; this appears to break outl-mouse for some reason.
  508. ;;;
  509. (defvar fume-found-function-hook nil
  510.   "*Hook to call after every function match.")
  511.  
  512. ;;; Idea for jumping directly with a mouse click
  513. ;;; Marc Paquette <Marc.Paquette@Softimage.COM>
  514. ;;;
  515. (defvar fume-no-prompt-on-valid-default nil
  516.   "*Set non-nil if 'fume-prompt-function-goto' should jump without prompting
  517. when a valid default exists.")
  518.  
  519. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  520. ;;;;;;;;;;;;;;;;;;;;;;;;;;  Buffer local variables  ;;;;;;;;;;;;;;;;;;;;;;;;
  521. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  522.  
  523. (fume-defvar-local
  524.  fume-auto-rescan-buffer-p t
  525.  "Buffer local variable which if non-nil permits automatic buffer rescanning
  526. by func-menu.
  527.  
  528. Usage:
  529. By default, fume-auto-rescan-buffer-p is set to non-nil. If you feel that
  530. a given mode 'foo' is becoming too slow as a result of automatic rescanning
  531. by func-menu, then do something along the lines of the following:
  532.  
  533.    (defun remove-func-menu-auto-rescan ()
  534.       (setq fume-auto-rescan-buffer-p nil))
  535.  
  536.    (add-hook 'foo-mode-hook 'remove-func-menu-auto-rescan)")
  537.  
  538. (fume-defvar-local
  539.  fume-funclist nil
  540.  "The latest list of function names in the buffer")
  541.  
  542. (fume-defvar-local
  543.  fume-function-name-regexp nil
  544.  "The keywords to show in a menu")
  545.  
  546. (fume-defvar-local
  547.  fume-find-next-function-name-method nil
  548.  "The function to use to find the next function name in the buffer")
  549.  
  550. (fume-defvar-local
  551.  fume-modeline-funclist nil
  552.  "The latest list of function names in the buffer to display in the modeline")
  553.  
  554. (fume-defvar-local
  555.  fume-funclist-dirty-p nil
  556.  "Flags whether the buffer is in need of a fresh scan")
  557.  
  558. (fume-defvar-local
  559.  fume-rescan-inhibit-p nil
  560.  "Internal variable only. DO NOT TOUCH.")
  561.  
  562. (fume-defvar-local
  563.  fume-rescan-trigger-counter 0
  564.  "Used in large buffers to optimise checking frequency")
  565.  
  566. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  567. ;;;;;;;;;;;;;;;;;;;;;  Mode specific regexp's and hooks  ;;;;;;;;;;;;;;;;;;;
  568. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  569.  
  570. ;;; Every fume-function-name-regexp-<language> should uniquely identify a
  571. ;;; function for that certain language.
  572.  
  573. ;;; Lisp
  574. ;;;
  575. ;;; Vladimir Alexiev <vladimir@cs.ualberta.ca>
  576. ;;; JTL: 24. Feb. 97 added "/" as part of function names
  577. (defvar fume-function-name-regexp-lisp
  578.   (concat
  579.    "^[ \t]*"                            ; Allow whitespace   |(or (fboundp 'foo)
  580.                                         ;  for the construct |    (defun foo ()
  581.    "(\\(def[^vc][a-z]*\\)"              ; Allow (def* except (defvar, (defconst
  582.    "\\s-+"                              ; At least one whitespace
  583.    "'?[#:?/A-Za-z0-9_+>-]+"             ; Allow (defalias 'foo 'bar)
  584.    "\\s-*"                              ; Whitespace
  585.    "\\(nil\\|(\\)"                      ; nil or (arg list
  586.    )
  587.   "Expression to get lisp function names")
  588.  
  589. ;;; C
  590. ;;;
  591. ;;; Danny Bar-Dov <danny@acet02.amil.co.il>
  592. ;;; Bob Weiner    <weiner@altrasoft.com> added #define macro support.
  593. (defvar fume-function-name-regexp-c
  594.   (concat
  595.    "^\\([a-zA-Z0-9]+\\|#define\\)\\s-?" ; type specs; there can be no
  596.    "\\([a-zA-Z0-9_*]+\\s-+\\)?"         ; more than 3 tokens, right?
  597.    "\\([a-zA-Z0-9_*]+\\s-+\\)?"
  598.    "\\([*&]+\\s-*\\)?"                  ; pointer
  599.    "\\([a-zA-Z0-9_*]+\\)[ \t\n]*("      ; name
  600.    )
  601.   "Expression to get C function names")
  602.  
  603. ;;; C++
  604. ;;;
  605. ;;; Andy Piper      <ajp@eng.cam.ac.uk>
  606. ;;; Kevin R. Powell <powell@csl.ncsa.uiuc.edu>
  607. ;;; Mats Lidell     <mats.lidell@eua.ericsson.se>
  608. ;;; Mike Battaglia  <mbattagl@spd.dsccc.com>
  609. ;;; Oliver Schittko <schittko@fokus.gmd.de>
  610. ;;; Tom Murray      <tmurray@hpindck.cup.hp.com>
  611. ;;; Bob Weiner      <weiner@altrasoft.com> added #define macro support.
  612. (defvar fume-function-name-regexp-c++
  613.   (cons
  614.    (concat
  615.     "^\\(#define\\s-+\\|"
  616.     "\\(template\\s-+<[^>]+>\\s-+\\)?"           ; template formals
  617.     "\\([a-zA-Z0-9_*&<,>:]+\\s-+\\)?"            ; type specs; there can be no
  618.     "\\([a-zA-Z0-9_*&<,>\"]+\\s-+\\)?"           ; more than 3 tokens, right?
  619.     "\\([a-zA-Z0-9_*&<,>]+\\s-+\\)?\\)"
  620.     "\\(\\([a-zA-Z0-9_&~:<,>*]\\|\\(\\s +::\\s +\\)\\)+\\)"
  621.     "\\(o?perator\\s *.[^(]*\\)?\\(\\s-\\|\n\\)*(" ; name
  622.     ) 6)
  623.   "Expression to get C++ function names")
  624.  
  625. ;;; FORTRAN
  626. ;;;
  627. ;;; Paul Emsley <paule@chem.gla.ac.uk>
  628. ;;; Raymond L. Toy <toy@soho.crd.ge.com>
  629. ;;; Richard Cognot <cognot@elfgrc.co.uk>
  630. ;;; Greg Sjaardema <gdsjaar@sandia.gov>
  631. (defvar fume-function-name-regexp-fortran
  632.   (concat
  633.    ;; >= six spaces
  634.    "^      \\s-*"
  635.    ;; type specs
  636.    "[a-zA-Z0-9*]*\\s-*"
  637.    ;; continuation lines
  638.    "\\(\n     [^ 0]\\s-*\\)*"
  639.    ;; function or subroutine
  640.    "\\(entry\\|ENTRY\\|function\\|FUNCTION\\|subroutine\\|SUBROUTINE\\)\\s-*"
  641.    ;; continuation lines
  642.    "\\(\n     [^ 0]\\s-*\\)*"
  643.    )
  644.   "Expression to get Fortran 77 function and subroutine names")
  645.  
  646. ;;; John Turner <turner@xdiv.lanl.gov>
  647. (defvar fume-function-name-regexp-fortran90
  648.   (concat
  649.    ;; type specs
  650.    "[a-zA-Z0-9*]*\\s-*"
  651.    ;; function or subroutine
  652.    "\\(entry\\|ENTRY\\|function\\|FUNCTION\\|module\\|MODULE\\|subroutine\\|SUBROUTINE\\)\\s-*"
  653.    )
  654.   "Expression to get Fortran 90 function, module and subroutine names")
  655.  
  656. ;;; Modula
  657. (defvar fume-function-name-regexp-modula
  658.   "^\\s-*PROCEDURE\\s-+[A-Za-z0-9_-]+"
  659.   "Expression to get Modula function names")
  660.  
  661. ;;; Bacis2
  662. ;;;
  663. ;;; CV MEDUSA's 4th generation language
  664. (defvar fume-function-name-regexp-bacis
  665.   "module_define(!\\|define_constant(!\\|sys_sysdefine(!\\|<<dbgid +\\s-*"
  666.   "Expression to get Bacis2 function names")
  667.  
  668. ;;; Maple
  669. ;;;
  670. ;;; Luc Tancredi <Luc.Tancredi@sophia.inria.fr>
  671. (defvar fume-function-name-regexp-maple
  672.   "^[ \t]*[a-zA-Z0-9_]+[ \t]*:=[ \t]*proc[ \t]*("
  673.   "Expression to get maple function/procedure names")
  674.  
  675. ;;; Tcl
  676. ;;;
  677. ;;; Andy Piper <ajp@eng.cam.ac.uk>
  678. ;;; Jean-Michel Augusto <augusto@eureecom.fr>
  679. ;;; Dr P.G. Sjoerdsma <pgs1002@esc.cam.ac.uk>
  680. (defvar fume-function-name-regexp-tcl
  681.   (cons "^\\s *proc\\s +\\(\\S-+\\)\\s *{" 1)
  682.   "Expression to get Tcl function Names")
  683.  
  684. ;;; Java
  685. ;;;
  686. ;;; Heddy Boubaker <boubaker@dgac.fr>
  687. (defvar fume-function-name-regexp-java
  688.   "\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)[\n \t\r]*\\((\\)"
  689.   "Expression to get Java methods names")
  690.  
  691. ;;; Perl
  692. ;;;
  693. ;;; Alex Rezinsky <alexr@msil.sps.mot.com>
  694. ;;; Michael Lamoureux <lamour@engin.umich.edu>
  695. (defvar fume-function-name-regexp-perl "^sub[ \t]+\\([A-Za-z0-9_]+\\)"
  696.   "Expression to get Perl function Names")
  697.  
  698. ;;; Python support
  699. ;;; Shuichi Koga <skoga@virginia.edu>
  700. ;;;
  701. (defvar fume-function-name-regexp-python
  702.   "^\\s-*\\(class\\|def\\)+\\s-*\\([A-Za-z0-9_]+\\)\\s-*[(:]"
  703.   "Expression to get Python class and function names")
  704.  
  705. ;;; Postscript
  706. ;;;
  707. ;;; Leigh L. Klotz <klotz@adoc.xerox.com>
  708. (defvar fume-function-name-regexp-postscript
  709.   "^/[^][ \t{}<>]*"
  710.   "Expression to get postscript function names")
  711.  
  712. ;;; Prolog
  713. ;;;
  714. ;;; Laszlo Teleki <laszlo@ipb.uni-bonn.de>
  715. (defvar fume-function-name-regexp-prolog
  716.   "^[a-z][a-zA-Z0-9_]+"
  717.   "Expression to get prolog fact and clause names")
  718.  
  719. ;;; Ehdm
  720. ;;;
  721. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  722. (defvar fume-function-name-regexp-ehdm
  723.   (concat
  724.    "[A-Za-z0-9_]*:[ ]*"
  725.    "\\([Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\|"
  726.    "[Ll][Ee][Mm][Mm][Aa]\\|"
  727.    "[Aa][Xx][Ii][Oo][Mm]\\|"
  728.    "[Pp][Rr][Oo][Vv][Ee]\\|"
  729.    "[Tt][Hh][Ee][Oo][Rr][Ee][Mm]"
  730.    "\\)"
  731.    )
  732.   "*Expression to get Ehdm function, theorems, axioms, lemmas, and proofs.")
  733.  
  734. ;;; PVS
  735. ;;;
  736. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  737. (defvar fume-function-name-regexp-pvs
  738.   (concat
  739.    "\\([A-Za-z0-9_]*:[ ]*"
  740.    "\\([Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\|"
  741.    "[Ll][Ee][Mm][Mm][Aa]\\|"
  742.    "[Aa][Xx][Ii][Oo][Mm]\\|"
  743.    "[Tt][Hh][Ee][Oo][Rr][Ee][Mm]\\|"
  744.    "[Ff][Or][Rr][Mm][Uu][La][Aa]"
  745.    "\\|"
  746.    "\\[.*\\]"
  747.    "\\)\\)\\|"
  748.    "[A-Za-z0-9_]*(.*)[ ]*:"
  749.    )
  750.   "*Expression to get PVS functions, theorems, axioms, lemmas")
  751.  
  752. ;;; Tex, LaTex
  753. ;;;
  754. ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
  755. ;;; Paolo Frasconi <paolo@mcculloch.ing.unifi.it>
  756. (fume-defvar-local fume-tex-chapter 0)
  757. (fume-defvar-local fume-tex-section 0)
  758. (fume-defvar-local fume-tex-subsection 0)
  759. (fume-defvar-local fume-tex-subsubsection 0)
  760.  
  761. (defun fume-tex-rescan-buffer-hook ()
  762.   (setq fume-tex-chapter 0
  763.         fume-tex-section 0
  764.         fume-tex-subsection 0
  765.         fume-tex-subsubsection 0))
  766.  
  767. (defun fume-tweak-tex-mode ()
  768.   (setq fume-sort-function nil)
  769.   (add-hook 'fume-rescan-buffer-hook 'fume-tex-rescan-buffer-hook))
  770.  
  771. (add-hook 'tex-mode-hook 'fume-tweak-tex-mode)
  772. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  773. (add-hook 'TeX-mode-hook 'fume-tweak-tex-mode)
  774. ;;; Wolfgang Mettbach <wolle@uni-paderborn.de>
  775. (add-hook 'latex-mode-hook 'fume-tweak-tex-mode)
  776. (add-hook 'LaTeX-mode-hook 'fume-tweak-tex-mode)
  777.  
  778. ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
  779. (defvar fume-section-name-regexp-latex
  780.   (concat
  781.    "^\\s-*\\\\\\("
  782.    "\\(sub\\)*section\\|chapter\\)"
  783.    "\\*?\\(\\[[^]]*\\]\\)?{\\([^}]*\\)}"
  784.    )
  785.   "Expression to get latex section names")
  786.  
  787. ;;; ksh
  788. ;;;
  789. ;;; Philippe Bondono <bondono@vnet.ibm.com>
  790. (defvar fume-function-name-regexp-ksh
  791.   (concat
  792.    "\\(^\\s-*function\\s-+[A-Za-z_][A-Za-z_0-9]*\\)"
  793.    "\\|"
  794.    "\\(^\\s-*[A-Za-z_][A-Za-z_0-9]*\\s-*()\\)")
  795.   "Expression to get ksh function names")
  796.  
  797. ;;; Scheme
  798. ;;;
  799. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  800. (defvar fume-function-name-regexp-scheme
  801.   "^(define [ ]*"
  802.   "Expression to get Scheme function names")
  803.  
  804. ;;; BibTeX
  805. ;;;
  806. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  807. (defvar fume-function-name-regexp-bibtex
  808.   ;; "^@[A-Za-z]*[({]\\([A-Za-z0-9:;&-]*\\),"
  809.   ;; Christoph Wedler <wedler@fmi.uni-passau.de>
  810.   ;; According to the LaTeX Companion, this should be
  811.   "^@[A-Za-z]*[({]\\([A-Za-z][^ \t\n\"#%'(),={}]*\\),"
  812.   "Expression to get bibtex citation headers.")
  813.  
  814. ;;; SGML
  815. ;;;
  816. ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
  817. (defvar fume-function-name-regexp-sgml
  818.   "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([A-Za-z][-A-Za-z.0-9]*\\)"
  819.   "Expression to find declaration of SGML element or entity")
  820.  
  821. ;;; Ada
  822. ;;;
  823. ;;; Michael Polo <mikep@polo.mn.org> <mikep@cfsmo.honeywell.com>
  824. (defvar fume-function-name-regexp-ada
  825.   (cons "^[ \t]*\\(procedure\\|PROCEDURE\\|function\\|FUNCTION\\)[ \n\t]+\\([a-zA-Z0-9_]+\\|\"[^\"]\"\\)" 2)
  826.   "Expression to find declaration of Ada function")
  827.  
  828. ;;; ignore prototypes, 'renames', 'is new' to eliminate clutter
  829. ;;;
  830. ;;; Scott Evans <gse@ocsystems.com>
  831. (defvar fume-function-name-regexp-ada-ignore
  832.   "[ \n\t]*\\(([^()]+)[ \n\t]*\\)?\\(return[ \t\n]+[^ \t\n;]+[ \n\t]*\\)?\\(;\\|is[ \n\t]+new[ \n\t]\\|renames\\)"
  833.   "ignore if ada function name matches this string")
  834.  
  835. ;;; Makefiles
  836. ;;;
  837. ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
  838. (defvar fume-function-name-regexp-make
  839.   "^\\(\\(\\$\\s(\\)?\\(\\w\\|\\.\\)+\\(:sh\\)?\\(\\s)\\)?\\)\\s *\\(::?\\|\\+?=\\)"
  840.   "Expression to get makefile target names")
  841. ;;(add-hook 'makefile-mode-hook 'fume-add-menubar-entry)
  842.  
  843. ;;; Directory Listings
  844. ;;;
  845. ;;; Norbert Kiesel <norbert@i3.informatik.rwth-aachen.de>
  846. ;;; regexp stolen from font-lock-mode
  847. (defvar fume-function-name-regexp-dired
  848.   "^. +d.*\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\) +[0-9]+ +[0-9:]+ \\(.*\\)$"
  849.   "Expression to get directory names")
  850.  
  851. ;;; Pascal
  852. ;;;
  853. ;;; Espen Skoglund <espensk@stud.cs.uit.no>
  854. (defvar fume-function-name-regexp-pascal
  855.   "^\\(function\\|procedure\\)[ \t]+\\([_a-zA-Z][_a-zA-Z0-9]*\\)"
  856.   "Expression to get function/procedure names in pascal.")
  857.  
  858.  
  859. ;;; Fame
  860. ;;;
  861. ;;; Cooper Vertz <cooper@prod2.imsi.com>
  862. (defvar fume-function-name-regexp-fame
  863.   "^\\(function\\|procedure\\)[ \t]+\\([#\\$%_a-zA-Z][#\\$%_a-zA-Z0-9]*\\)"
  864.   "Expression to get function/procedure names in fame.")
  865.  
  866.  
  867. ;;; Verilog
  868. ;;;
  869. ;;; Matt Sale <mdsale@icdc.delcoelect.com>
  870. (defvar fume-function-name-regexp-verilog
  871.   "^\\(task\\|function\\|module\\|primitive\\)[ \t]+\\([A-Za-z0-9_+-]*\\)[ \t]*(?"
  872.   "Expression to get verilog module names")
  873.  
  874. ;;; Idl
  875. ;;;
  876. ;;; Lubos Pochman <lubos@rsinc.com>
  877. (defvar fume-function-name-regexp-idl
  878.   (cons "^\\s *\\([pP][rR][oO]\\|[fF][uU][nN][cC][tT][iI][oO][nN]\\)\\s +\\([A-Za-z][A-Za-z0-9_$]*\\)" 2)
  879.   "Expression to get Idl function Names")
  880.  
  881. ;;; Assembly
  882. (defvar fume-function-name-regexp-asm
  883.   "^\\([a-zA-Z_.$][a-zA-Z0-9_.$]*\\)[ \t]*:"
  884.   "Expression to get assembly label names")
  885.  
  886. ;;; This is where the mode specific regexp's are hooked in
  887. ;;;
  888. (defvar fume-function-name-regexp-alist
  889.   '(;; Lisp
  890.     (emacs-lisp-mode              . fume-function-name-regexp-lisp)
  891.     (common-lisp-mode             . fume-function-name-regexp-lisp)
  892.     (fi:common-lisp-mode          . fume-function-name-regexp-lisp)
  893.     (fi:emacs-lisp-mode           . fume-function-name-regexp-lisp)
  894.     (fi:franz-lisp-mode           . fume-function-name-regexp-lisp)
  895.     (fi:inferior-common-lisp-mode . fume-function-name-regexp-lisp)
  896.     (fi:inferior-franz-lisp-mode  . fume-function-name-regexp-lisp)
  897.     (fi:lisp-listener-mode        . fume-function-name-regexp-lisp)
  898.     (lisp-mode                    . fume-function-name-regexp-lisp)
  899.     (lisp-interaction-mode        . fume-function-name-regexp-lisp)
  900.  
  901.     ;; C
  902.     (c-mode      . fume-function-name-regexp-c)
  903.     (elec-c-mode . fume-function-name-regexp-c)
  904.     (c++-c-mode  . fume-function-name-regexp-c)
  905.  
  906.     ;; C++
  907.     (c++-mode . fume-function-name-regexp-c++)
  908.  
  909.     ;; Fortran
  910.     (fortran-mode . fume-function-name-regexp-fortran)
  911.     (f90-mode     . fume-function-name-regexp-fortran90)
  912.  
  913.     ;; Modula
  914.     (modula-2-mode . fume-function-name-regexp-modula)
  915.     (modula-3-mode . fume-function-name-regexp-modula)
  916.  
  917.     ;; Bacis2
  918.     (bacis-mode . fume-function-name-regexp-bacis)
  919.  
  920.     ;; Maple
  921.     (maple-mode . fume-function-name-regexp-maple)
  922.  
  923.     ;; Perl
  924.     (perl-mode . fume-function-name-regexp-perl)
  925.  
  926.     ;; Java
  927.     (java-mode . fume-function-name-regexp-java)
  928.  
  929.     ;; Python
  930.     (alice-mode  . fume-function-name-regexp-python)
  931.     (python-mode . fume-function-name-regexp-python)
  932.  
  933.     ;; Postscript
  934.     (postscript-mode . fume-function-name-regexp-postscript)
  935.  
  936.     ;; Prolog
  937.     (prolog-mode . fume-function-name-regexp-prolog)
  938.  
  939.     ;; Tcl
  940.     (tcl-mode . fume-function-name-regexp-tcl)
  941.  
  942.     ;; ksh
  943.     (ksh-mode . fume-function-name-regexp-ksh)
  944.  
  945.     ;; LaTeX
  946.     (latex-mode . fume-section-name-regexp-latex)
  947.     (LaTeX-mode . fume-section-name-regexp-latex)
  948.  
  949.     ;; Scheme
  950.     (scheme-mode . fume-function-name-regexp-scheme)
  951.  
  952.     ;; BibTeX
  953.     (bibtex-mode . fume-function-name-regexp-bibtex)
  954.  
  955.     ;; Ehdm & PVS
  956.     (ehdm-mode . fume-function-name-regexp-ehdm)
  957.     (pvs-mode  . fume-function-name-regexp-pvs)
  958.  
  959.     ;; SGML
  960.     (sgml-mode . fume-function-name-regexp-sgml)
  961.  
  962.     ;; Ada
  963.     (ada-mode . fume-function-name-regexp-ada)
  964.  
  965.     ;; Makefiles
  966.     (makefile-mode . fume-function-name-regexp-make)
  967.  
  968.     ;; Dired
  969.     (dired-mode . fume-function-name-regexp-dired)
  970.  
  971.     ;; Pascal
  972.     (pascal-mode . fume-function-name-regexp-pascal)
  973.  
  974.     ;; Fame
  975.     (fame-mode . fume-function-name-regexp-fame)
  976.  
  977.     ;; Verilog
  978.     (verilog-mode . fume-function-name-regexp-verilog)
  979.  
  980.     ;; Idl
  981.     (idl-mode . fume-function-name-regexp-idl)
  982.  
  983.     ;; Assembly
  984.     (asm-mode . fume-function-name-regexp-asm)
  985.     )
  986.  
  987.   "The connection between a mode and the regexp that matches function names.")
  988.  
  989. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  990. ;;;;;;;;;;;;;;;;;;;;;  Mode specific finding functions  ;;;;;;;;;;;;;;;;;;;;
  991. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  992.  
  993. ;;; Default routine : Note, most modes will need a specialised routine
  994. ;;;
  995. (defun fume-find-next-function-name (buffer)
  996.   "Searches for the next function in BUFFER."
  997.   (set-buffer buffer)
  998.   ;; Search for the function
  999.   (if (re-search-forward fume-function-name-regexp nil t)
  1000.       (let ((char (progn
  1001.                     (if (string-match
  1002.                          "[({[]"
  1003.                          (char-to-string (char-after (1- (point)))))
  1004.                         (backward-char)
  1005.                       (forward-word -1))
  1006.                     (save-excursion
  1007.                       (goto-char (scan-sexps (point) 1))
  1008.                       (skip-chars-forward "[ \t\n]")
  1009.                       (following-char)))))
  1010.         ;; Skip this function name if it is a prototype declaration.
  1011.         (if (and (eq char ?\;) (not (eq major-mode 'emacs-lisp-mode)))
  1012.             (fume-find-next-function-name buffer)
  1013.           ;; Get the function name and position
  1014.           (let (beg)
  1015.             (forward-sexp -1)
  1016.             (setq beg (point))
  1017.             (forward-sexp)
  1018.             (cons (buffer-substring beg (point)) beg))))))
  1019.  
  1020. ;;; General purpose sexp find function
  1021. ;;;
  1022. (defun fume-find-next-sexp (buffer)
  1023.   "Searches for the next sexp type function in BUFFER."
  1024.   (set-buffer buffer)
  1025.   (if (re-search-forward fume-function-name-regexp nil t)
  1026.       (let ((beg (save-excursion (forward-sexp -1) (point))))
  1027.         (cons (buffer-substring beg (point)) beg))))
  1028.  
  1029. ;;; Specialised routine to get the next ehdm entity in the buffer.
  1030. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  1031. ;;;
  1032. (defun fume-find-next-ehdm-entity (buffer)
  1033.   (set-buffer buffer)
  1034.   (if (re-search-forward fume-function-name-regexp nil t)
  1035.       (let ((beg (match-beginning 0))
  1036.             (end (match-end 0)))
  1037.         (cons (buffer-substring beg end) beg))))
  1038.  
  1039. ;;; Specialised routine to get the next PVS entity in the buffer.
  1040. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  1041. ;;;
  1042. (defun fume-find-next-pvs-entity (buffer)
  1043.   (set-buffer buffer)
  1044.   (if (re-search-forward fume-function-name-regexp nil t)
  1045.       (let ((beg (match-beginning 0))
  1046.             (end (match-end 0)))
  1047.         (goto-char (1- end))
  1048.         (if (looking-at ":")
  1049.             (setq end (1- end)))
  1050.         (cons (buffer-substring beg end) beg))))
  1051.  
  1052. ;;; Specialised routine to get the next C function name in the buffer.
  1053. ;;; Modified 16/12/96: Jerome Bertorelle <bertorel@telspace.alcatel.fr>
  1054. ;;;
  1055. (defun fume-find-next-c-function-name (buffer)
  1056.   "Searches for the next C function in BUFFER."
  1057.   (set-buffer buffer)
  1058.   ;; Search for the function
  1059.   (if (re-search-forward fume-function-name-regexp nil t)
  1060.       (let ((char (progn
  1061.                     (backward-up-list 1)
  1062.                     (save-excursion
  1063.                       (goto-char (scan-sexps (point) 1))
  1064.                       (skip-chars-forward "[ \t\n]")
  1065.                       (following-char)))))
  1066.         ;; Skip this function name if it is a prototype declaration.
  1067.         (if (eq char ?\;)
  1068.             (fume-find-next-c-function-name buffer)
  1069.           (let (beg
  1070.                 name)
  1071.             ;; Get the function name and position
  1072.             (forward-sexp -1)
  1073.             (setq beg (point))
  1074.             (forward-sexp)
  1075.             (setq name (buffer-substring beg (point)))
  1076.             ;; ghastly crock for DEFUN declarations
  1077.             (cond ((string-match "^DEFUN\\s-*" name)
  1078.                    (forward-word 1)
  1079.                    (forward-word -1)
  1080.                    (setq beg (point))
  1081.                    (cond ((re-search-forward "\"," nil t)
  1082.                           (re-search-backward "\"," nil t)
  1083.                           (setq name
  1084.                                 (format "%s %s"
  1085.                                         name
  1086.                                         (buffer-substring beg (point))))))))
  1087.             ;; kludge to avoid 'void' etc in menu
  1088.             (if (string-match "^void$\\|^if$\\|^switch$\\|^while$" name)
  1089.                 (fume-find-next-c-function-name buffer)
  1090.               (cons name beg)))))))
  1091.  
  1092. ;;; Peter Pezaris <pez@dwwc.com>
  1093. ;;;
  1094. (defun fume-cc-inside-comment ()
  1095.   (memq (buffer-syntactic-context) '(comment block-comment)))
  1096.  
  1097. ;;; <jrm@odi.com>
  1098. ;;; <ajp@eng.cam.ac.uk>
  1099. ;;; <schittko@fokus.gmd.de>
  1100. ;;; <d.hughes@videonetworks.com> - speedup, David Hughes 24th November 1996
  1101. ;;;
  1102. (defun fume-match-find-next-function-name (buffer)
  1103.   ;; General next function name in BUFFER finder using match.
  1104.   ;; The regexp is assumed to be a two item list the car of which is the regexp
  1105.   ;; to use, and the cdr of which is the match position of the function name
  1106.   (set-buffer buffer)
  1107.   (let ((r (car fume-function-name-regexp))
  1108.         (p (cdr fume-function-name-regexp)))
  1109.     (catch 'found
  1110.       (while (re-search-forward r nil t)
  1111.         (catch 'skip
  1112.           (if (fume-cc-inside-comment) (throw 'skip t))
  1113.           (save-excursion
  1114.             (re-search-backward r nil t)
  1115.             (if (string= "typedef" (fume-what-looking-at)) (throw 'skip t))
  1116.             (re-search-forward r nil t))
  1117.           (backward-up-list 1)
  1118.           (save-excursion
  1119.             (goto-char (scan-sexps (point) 1))
  1120.             (if (eq ?\; (following-char)) (throw 'skip t))) ; skip prototypes
  1121.           (throw
  1122.            'found
  1123.            (cons (buffer-substring (setq p (match-beginning p)) (point)) p))))
  1124.       nil)))
  1125.  
  1126. ;;; Specialised routine to find the next Perl function
  1127. ;;;
  1128. (defun fume-find-next-perl-function-name (buffer)
  1129.   "Searches for the next Perl function in BUFFER."
  1130.   (fume-find-next-sexp buffer))
  1131.  
  1132. ;;; Specialised routine to find the next Java function
  1133. ;;; Bob Weiner <weiner@altrasoft.com>
  1134. ;;; Heddy Boubaker <boubaker@dgac.fr>
  1135. ;;;
  1136. (defun fume-find-next-java-function-name (buffer)
  1137.   "Searches for the next Java function in BUFFER."
  1138.   (set-buffer buffer)
  1139.   (if (re-search-forward fume-function-name-regexp nil t)
  1140.       (let ((beg (match-beginning 1))
  1141.             (end (match-end       1)))
  1142.         (goto-char (match-beginning 2))
  1143.         (forward-sexp)
  1144.         (if (and (looking-at "[^;(]*{")
  1145.                  (not (fume-cc-inside-comment)))
  1146.             ;; This is a method definition and we're not in a comment
  1147.             (let ((str (buffer-substring beg end)))
  1148.               ;; Bob Weiner <weiner@altrasoft.com> added exact match
  1149.               ;; delimiters so function names that happen to contain
  1150.               ;; any of these terms are not eliminated.  The old version
  1151.               ;; would ignore "notify()" since it contained "if".
  1152.               (or (string-match "\\`\\(if\\|switch\\|catch\\|for\\|while\\)\\'"
  1153.                                 str)
  1154.                   ;; These constructs look like method definitions but are not
  1155.                   (cons str beg)))
  1156.           (fume-find-next-java-function-name buffer)))))
  1157.  
  1158. ;;; Specialised routine to find the next Python function
  1159. ;;; Shuichi Koga <skoga@virginia.edu>
  1160. ;;;
  1161. (defun fume-find-next-python-function-name (buffer)
  1162.   "Searches for the next python function in BUFFER."
  1163.   (set-buffer buffer)
  1164.   (if (re-search-forward fume-function-name-regexp nil t)
  1165.       (save-excursion
  1166.         (let* ((retpnt (match-beginning 2))
  1167.                (retname (buffer-substring retpnt (match-end 2))))
  1168.           (goto-char (match-beginning 0))
  1169.           (cond ((looking-at "\\s-+def")
  1170.                  (re-search-backward
  1171.                   "^class\\s-*\\([A-Za-z0-9_]+\\)\\s-*[(:]" nil t)
  1172.                  (setq retname
  1173.                        (concat
  1174.                         (buffer-substring (match-beginning 1) (match-end 1))
  1175.                         "."
  1176.                         retname))))
  1177.           (cons retname retpnt)))))
  1178.  
  1179. ;;; Specialised routine to find the next Modula function or subroutine.
  1180. ;;;
  1181. (defun fume-find-next-modula-function-name (buffer)
  1182.   "Searches for the next modula function in BUFFER."
  1183.   (fume-find-next-sexp buffer))
  1184.  
  1185. ;;; Specialised routine to find the next directory.
  1186. ;;; Norbert Kiesel <norbert@i3.informatik.rwth-aachen.de>
  1187. ;;;
  1188. (defun fume-find-next-directory-name (buffer)
  1189.   "Searches for the next directory in dired BUFFER."
  1190.   (set-buffer buffer)
  1191.   ;; Search for the function
  1192.   (if (re-search-forward fume-function-name-regexp nil t)
  1193.       (let ((beg (match-beginning 2))
  1194.             (end (match-end 2)))
  1195.         (cons (buffer-substring beg end) beg))))
  1196.  
  1197. ;;; Specialised routine to find the next Fortran function or subroutine
  1198. ;;;
  1199. (defun fume-find-next-fortran-function-name (buffer)
  1200.   "Searches for the next Fortran function in BUFFER."
  1201.   (set-buffer buffer)
  1202.   (if (re-search-forward fume-function-name-regexp nil t)
  1203.       (let ((pos (point))
  1204.             ;; name may have "_" but must start with a letter
  1205.             (name-regexp "\\s-+[a-zA-Z]+[_a-zA-Z0-9*]*")
  1206.             (eol (save-excursion (end-of-line 1) (point))))
  1207.         (skip-chars-backward " \t")
  1208.         (if (re-search-forward name-regexp eol t)
  1209.             ;; name is ok; so return it
  1210.             (cons (buffer-substring pos (point)) pos)
  1211.           ;; rubbish found; skip to next function
  1212.           (fume-find-next-fortran-function-name buffer)))))
  1213.  
  1214. ;;; Specialised routine to get the next postscript function name in the buffer
  1215. ;;; Leigh L. Klotz <klotz@adoc.xerox.com>
  1216. ;;;
  1217. (defun fume-find-next-postscript-function-name (buffer)
  1218.   "Searches for the next postscript function in BUFFER."
  1219.   (set-buffer buffer)
  1220.   (if (re-search-forward fume-function-name-regexp nil t)
  1221.       (let ((beg (progn (beginning-of-line 1) (point))))
  1222.         (forward-sexp)
  1223.         ;; keep including sexps as long as they
  1224.         ;; start with / or [.
  1225.         (if (looking-at "\\s-+\\(/\\|\\[\\)")
  1226.             (forward-sexp))
  1227.         (cons (buffer-substring beg (point)) beg))))
  1228.  
  1229. ;;; Specialised routine to get the next prolog fact/clause name in the buffer
  1230. ;;; Laszlo Teleki <laszlo@ipb.uni-bonn.de>
  1231. ;;;
  1232. (defun fume-find-next-prolog-function-name (buffer)
  1233.   "Searches for the next prolog fact or clause in BUFFER."
  1234.   (set-buffer buffer)
  1235.   (if (re-search-forward fume-function-name-regexp nil t)
  1236.       (let ((beg (progn (beginning-of-line 1) (point))))
  1237.         (forward-sexp)
  1238.         (cons (buffer-substring beg (point)) beg))))
  1239.  
  1240. ;;; Specialised routine to get the next bacis2 procedure name in the buffer
  1241. ;;;
  1242. (defun fume-find-next-bacis-function-name (buffer)
  1243.   "Searches for the next Bacis2 function in BUFFER"
  1244.   (set-buffer buffer)
  1245.   (if (re-search-forward fume-function-name-regexp nil t)
  1246.       (let ((pos (point))
  1247.             (name (condition-case ()
  1248.                       (funcall
  1249.                        (symbol-function (intern "focus-get-function-name")))
  1250.                     (error nil))))
  1251.         (if (null name)
  1252.             (fume-find-next-bacis-function-name buffer)
  1253.           ;; jump past possible function dbgid
  1254.           (re-search-forward
  1255.            (format "<<dbgid +\\s-*%s%s" name "\\s-*>>") nil t)
  1256.           (cons name pos)))))
  1257.  
  1258. ;;; Specialized routine to get the next Maple function name in the buffer
  1259. ;;; Luc Tancredi <Luc.Tancredi@sophia.inria.fr>
  1260. ;;;
  1261. (defun fume-find-next-maple-function-name (buffer)
  1262.   "Searches for the next maple function in BUFFER"
  1263.   (set-buffer buffer)
  1264.   ;; Search for the function
  1265.   (if (re-search-forward fume-function-name-regexp nil t)
  1266.       (let ((beg (progn (backward-up-list 1) (forward-sexp -2) (point))))
  1267.         (forward-sexp)
  1268.         (cons (buffer-substring beg (point)) beg))))
  1269.  
  1270. ;;; Specialised routine to get the next latex section name in the buffer
  1271. ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
  1272. ;;; Paolo Frasconi <paolo@mcculloch.ing.unifi.it>
  1273. ;;;
  1274. (defun fume-find-next-latex-section-name (buffer)
  1275.   "Searches for the next latex section in BUFFER."
  1276.   (set-buffer buffer)
  1277.   (if (re-search-forward fume-function-name-regexp nil t)
  1278.       (let* ((secname (buffer-substring (match-beginning 1) (match-end 1)))
  1279.              (beg (match-beginning 4))
  1280.              (name (buffer-substring beg (match-end 4))))
  1281.         (cond ((string= secname "chapter")
  1282.                (setq fume-tex-chapter (1+ fume-tex-chapter)
  1283.                      fume-tex-section 0
  1284.                      fume-tex-subsection 0
  1285.                      fume-tex-subsubsection 0
  1286.                      name (concat fume-tex-chapter " " (upcase name))))
  1287.               ((string= secname "section")
  1288.                (setq fume-tex-section (1+ fume-tex-section)
  1289.                      name (concat
  1290.                            (if (> fume-tex-chapter 0)
  1291.                                (concat fume-tex-chapter ".") "")
  1292.                            fume-tex-section " " name)
  1293.                      fume-tex-subsection 0
  1294.                      fume-tex-subsubsection 0))
  1295.               ((string= secname "subsection")
  1296.                (setq fume-tex-subsection (1+ fume-tex-subsection)
  1297.                      name (concat
  1298.                            (if (> fume-tex-chapter 0)
  1299.                                (concat fume-tex-chapter ".") "")
  1300.                            fume-tex-section "."
  1301.                            fume-tex-subsection " " name)
  1302.                      fume-tex-subsubsection 0))
  1303.               ((string= secname "subsubsection")
  1304.                (setq fume-tex-subsubsection (1+ fume-tex-subsubsection)
  1305.                      name (concat
  1306.                            (if (> fume-tex-chapter 0)
  1307.                                (concat fume-tex-chapter ".") "")
  1308.                            fume-tex-section "."
  1309.                            fume-tex-subsection "."
  1310.                            fume-tex-subsubsection " " name)))
  1311.               ((string= secname "subsubsection")
  1312.                (setq name (concat "   " name))))
  1313.         (cons name beg))))
  1314.  
  1315. ;;; Specialised routine to get the next ksh function in the buffer
  1316. ;;; Philippe Bondono <bondono@vnet.ibm.com>
  1317. ;;;
  1318. (defun fume-find-next-ksh-function-name (buffer)
  1319.   "Searches for the ksh type function in BUFFER."
  1320.   (set-buffer buffer)
  1321.   ;; Search for the function
  1322.   (if (re-search-forward fume-function-name-regexp nil t)
  1323.       (let (name
  1324.             (beg (match-beginning 0)))
  1325.         (cond ((re-search-backward "\\(^\\|\\s-\\)function\\s-" beg t)
  1326.                (re-search-forward
  1327.                 "\\(function\\s-+\\)\\([A-Za-z_][A-Za-z_0-9]*\\)" nil t)
  1328.                (setq beg (match-beginning 2)
  1329.                      name (buffer-substring beg (match-end 2))))
  1330.               (t
  1331.                (re-search-backward
  1332.                 "\\(^\\|\\s-\\)\\([A-Za-z_][A-Za-z_0-9]*\\)" beg t)
  1333.                (setq beg (match-beginning 2)
  1334.                      name (buffer-substring beg (match-end 2)))))
  1335.         (if (null name)
  1336.             (fume-find-next-ksh-function-name buffer)
  1337.           (end-of-line)
  1338.           (cons name beg)))))
  1339.  
  1340. ;;; Specialised routine to get the next Scheme function in the buffer
  1341. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  1342. ;;;
  1343. (defun fume-find-next-scheme-function (buffer)
  1344.   "Searches for the next Scheme function in BUFFER."
  1345.   (set-buffer buffer)
  1346.   (if (re-search-forward fume-function-name-regexp nil t)
  1347.       (let ((beg (progn (if (looking-at "(") (forward-char 1)) (point)))
  1348.             (end (save-excursion (forward-sexp) (point))))
  1349.         (cons (buffer-substring beg end) beg))))
  1350.  
  1351. ;;; Specialised routine to get the next BibTeX citation in the buffer
  1352. ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
  1353. ;;;
  1354. (defun fume-find-next-bibtex-citation (buffer)
  1355.   "Searches for the next BibTeX citation in BUFFER."
  1356.   (set-buffer buffer)
  1357.   (if (re-search-forward fume-function-name-regexp nil t)
  1358.       (let ((beg (match-beginning 1))
  1359.             (end (match-end 1)))
  1360.         (cons (buffer-substring beg end) beg))))
  1361.  
  1362. ;;; Specialised routine to get the next SGML declaration in the buffer
  1363. ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
  1364. ;;;
  1365. (defun fume-find-next-sgml-element-name (buffer)
  1366.   "Searches for the next SGML declaration in BUFFER."
  1367.   (set-buffer buffer)
  1368.   (if (re-search-forward fume-function-name-regexp nil t)
  1369.       (let ((type (buffer-substring (match-beginning 1) (match-end 1)))
  1370.             (beg (match-beginning 2))
  1371.             (name (buffer-substring (match-beginning 2) (match-end 2))))
  1372.         (if (string= (downcase type) "element")
  1373.             (setq name (format "%-17s%3s" name "EL"))
  1374.           (setq name (format "%-17s%3s" name "ENT")))
  1375.         (cons name beg))))
  1376.  
  1377. ;;; Specialised routine to get the next ada function in the buffer
  1378. ;;; Michael Polo <mikep@polo.mn.org> <mikep@cfsmo.honeywell.com>
  1379. ;;;
  1380. (defun fume-find-next-ada-function-name (buffer)
  1381.   "Searches for the next ada function in BUFFER."
  1382.   (set-buffer buffer)
  1383.   (if (re-search-forward (car fume-function-name-regexp-ada) nil t)
  1384.       (let ((beg (match-beginning (cdr fume-function-name-regexp-ada)))
  1385.             (end (match-end (cdr fume-function-name-regexp-ada))))
  1386.  
  1387.         (if (looking-at fume-function-name-regexp-ada-ignore)
  1388.             (fume-find-next-ada-function-name buffer)
  1389.           (cons (buffer-substring beg end) beg)))))
  1390.  
  1391. ;;; Makefiles
  1392. ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
  1393. ;;;
  1394. (defun fume-find-next-function-name-make (buffer)
  1395.   "Searches for the next make item in BUFFER."
  1396.   (set-buffer buffer)
  1397.   (if (re-search-forward fume-function-name-regexp nil t)
  1398.       (let ((beg (match-beginning 1))
  1399.             (end (match-end 1)))
  1400.         (cons (buffer-substring beg end) beg))))
  1401.  
  1402. ;;; Find next pascal function in the buffer
  1403. ;;; Espen Skoglund <espensk@stud.cs.uit.no>
  1404. ;;;
  1405. (defun fume-find-next-pascal-function-name (buffer)
  1406.   "Searches for the next pascal procedure in BUFFER."
  1407.   (set-buffer buffer)
  1408.   (if (re-search-forward fume-function-name-regexp nil t)
  1409.       (let ((beg (match-beginning 2))
  1410.             (end (match-end 2)))
  1411.         (cons (buffer-substring beg end) beg))))
  1412.  
  1413. ;;; Verilog support
  1414. ;;; Matt Sale <mdsale@icdc.delcoelect.com>
  1415. ;;;
  1416. (defun fume-find-next-verilog-function-name (buffer)
  1417.   "Searches for the next verilog module in BUFFER."
  1418.   (set-buffer buffer)
  1419.   (if (re-search-forward fume-function-name-regexp nil t)
  1420.       (let ((beg (match-beginning 2))
  1421.             (end (match-end 2)))
  1422.         (cons (buffer-substring beg end) beg))))
  1423.  
  1424. ;;; Specialised routine to get the next idl function in the buffer
  1425. ;;;
  1426. ;;; Lubos Pochman <lubos@rsinc.com>
  1427. (defun fume-find-next-idl-function-name (buffer)
  1428.   "Searches for the next idl function in BUFFER."
  1429.   (set-buffer buffer)
  1430.   (if (re-search-forward (car fume-function-name-regexp-idl) nil t)
  1431.       (let ((beg (match-beginning (cdr fume-function-name-regexp-idl)))
  1432.             (end (match-end (cdr fume-function-name-regexp-idl))))
  1433.         (cons (buffer-substring beg end) beg))))
  1434.  
  1435.  
  1436. ;;; Assembly
  1437. ;;; Bob Weiner <weiner@altrasoft.com>
  1438. ;;;
  1439. (defun fume-find-next-asm-function-name (buffer)
  1440.   "Searches for the next assembler function in BUFFER."
  1441.   (set-buffer buffer)
  1442.   ;; Search for the function
  1443.   (if (re-search-forward fume-function-name-regexp nil t)
  1444.       (cons (buffer-substring (match-beginning 1) (match-end 1))
  1445.             (match-beginning 1))))
  1446.  
  1447. ;;; This is where you can hook in other languages which may need a different
  1448. ;;; method to scan for function names. Otherwise, the default defun used is
  1449. ;;; fume-find-next-function-name which is suitable for sexp-based languages
  1450. ;;; such as C, C++ and elisp.
  1451. ;;;
  1452. (defconst fume-find-function-name-method-alist
  1453.   '((ada-mode        . fume-find-next-ada-function-name)
  1454.     (alice-mode      . fume-find-next-python-function-name)
  1455.     (asm-mode        . fume-find-next-asm-function-name)
  1456.     (bacis-mode      . fume-find-next-bacis-function-name)
  1457.     (bibtex-mode     . fume-find-next-bibtex-citation)
  1458.     (c++-mode        . fume-match-find-next-function-name)
  1459.     (c-mode          . fume-find-next-c-function-name)
  1460.     (dired-mode      . fume-find-next-directory-name)
  1461.     (ehdm-mode       . fume-find-next-ehdm-entity)
  1462.     (fame-mode       . fume-find-next-pascal-function-name)
  1463.     (fortran-mode    . fume-find-next-fortran-function-name)
  1464.     (f90-mode        . fume-find-next-fortran-function-name)
  1465.     (ksh-mode        . fume-find-next-ksh-function-name)
  1466.     (latex-mode      . fume-find-next-latex-section-name)
  1467.     (LaTeX-mode      . fume-find-next-latex-section-name)
  1468.     (makefile-mode   . fume-find-next-function-name-make)
  1469.     (maple-mode      . fume-find-next-maple-function-name)
  1470.     (modula-2-mode   . fume-find-next-modula-function-name)
  1471.     (modula-3-mode   . fume-find-next-modula-function-name)
  1472.     (pascal-mode     . fume-find-next-pascal-function-name)
  1473.     (perl-mode       . fume-find-next-perl-function-name)
  1474.     (java-mode       . fume-find-next-java-function-name)
  1475.     (postscript-mode . fume-find-next-postscript-function-name)
  1476.     (prolog-mode .     fume-find-next-prolog-function-name)
  1477.     (pvs-mode        . fume-find-next-pvs-entity)
  1478.     (python-mode     . fume-find-next-python-function-name)
  1479.     (scheme-mode     . fume-find-next-scheme-function)
  1480.     (sgml-mode       . fume-find-next-sgml-element-name)
  1481.     (tcl-mode        . fume-match-find-next-function-name)
  1482.     (verilog-mode    . fume-find-next-verilog-function-name)
  1483.     (idl-mode        . fume-find-next-idl-function-name)
  1484.     )
  1485.  
  1486.   "The connection between a mode and the defun that finds function names.
  1487. If no connection is in this alist for a given mode, a default method is used")
  1488.  
  1489. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1490. ;;;;;;;;;;;;;;;;;;;;;;;;  General utility functions  ;;;;;;;;;;;;;;;;;;;;;;;
  1491. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1492.  
  1493. ;;; modeline refresh routine
  1494. ;;;
  1495. (or (fboundp 'redraw-modeline)
  1496.     (defun redraw-modeline () (set-buffer-modified-p (buffer-modified-p))))
  1497.  
  1498. ;;; Smart mouse positioning
  1499. ;;;
  1500. (if (fboundp 'window-edges)             ; old method
  1501.     (defun fume-set-mouse-position ()
  1502.       (set-mouse-position
  1503.        (selected-frame)
  1504.        (nth 0 (window-edges)) (nth 1 (window-edges))))
  1505.   (defun fume-set-mouse-position ()     ; new method
  1506.     (set-mouse-position
  1507.      (selected-window)
  1508.      (nth 0 (window-pixel-edges))
  1509.      (nth 1 (window-pixel-edges)))))
  1510.  
  1511. ;;; Sets 'fume-function-name-regexp' to something appropriate for the current
  1512. ;;; mode for this buffer.
  1513. ;;;
  1514. (defun fume-set-defaults ()
  1515.   "Returns nil if unsuccessful in setting up buffer-local defaults.
  1516. Otherwise returns fume-function-name-regexp"
  1517.   (setq fume-function-name-regexp
  1518.         (symbol-value
  1519.          (cdr-safe (assoc major-mode fume-function-name-regexp-alist))))
  1520.   (if fume-function-name-regexp
  1521.       (setq fume-find-next-function-name-method
  1522.             (or (cdr-safe (assoc major-mode
  1523.                                  fume-find-function-name-method-alist))
  1524.                 'fume-find-next-function-name)))
  1525.   fume-function-name-regexp)
  1526.  
  1527. ;;; Routines to add/remove/update function menu from menubar
  1528. ;;;
  1529. (defun fume-add-menubar-entry ()
  1530.   (interactive)
  1531.   (save-window-excursion (function-menu t)))
  1532.  
  1533. (defun fume-remove-menubar-entry ()
  1534.   (interactive)
  1535.   (cond ((and fume-running-xemacs current-menubar)
  1536.          (delete-menu-item (list fume-menubar-menu-name))
  1537.          ;; force update of the menubar
  1538.          (redraw-modeline))))
  1539.  
  1540. (defun fume-update-menubar-entry ()
  1541.   "Returns t if menubar was updated. Nil otherwise"
  1542.   (and fume-running-xemacs
  1543.        fume-not-tty
  1544.        (assoc fume-menubar-menu-name current-menubar)
  1545.        (fume-add-menubar-entry)
  1546.        t))
  1547.  
  1548. (defun fume-trim-string (string)
  1549.   "Returns STRING with leading and trailing whitespace removed."
  1550.   (if (string-match "^[ \t]*" (setq string (format "%s" string)))
  1551.       (setq string (substring string (match-end 0))))
  1552.   (if (string-match "[ \t]*$" string)
  1553.       (setq string (substring string 0 (match-beginning 0))))
  1554.   string)
  1555.  
  1556. (defvar fume-syntax-table nil)
  1557.  
  1558. (defun fume-what-looking-at (&optional check-primary-selection-p)
  1559.   (or (and check-primary-selection-p
  1560.            primary-selection-extent
  1561.            (condition-case ()
  1562.                (prog1 (buffer-substring (region-beginning) (region-end))
  1563.                  (and zmacs-regions (zmacs-deactivate-region) (sit-for 0)))
  1564.              (error nil)))
  1565.       (let (name
  1566.             (orig-syntax-table (copy-syntax-table (syntax-table))))
  1567.         (if fume-syntax-table
  1568.             ()
  1569.           (setq fume-syntax-table (copy-syntax-table))
  1570.           (modify-syntax-entry ?: "w" fume-syntax-table))
  1571.         (unwind-protect
  1572.             (progn
  1573.               (set-syntax-table fume-syntax-table)
  1574.               (save-excursion
  1575.                 (while (looking-at "\\sw\\|\\s_") (forward-char 1))
  1576.                 (if (re-search-backward "\\sw\\|\\s_" nil t)
  1577.                     (let ((beg (progn (forward-char 1) (point))))
  1578.                       (forward-sexp -1)
  1579.                       (while (looking-at "\\s'") (forward-char 1))
  1580.                       (setq name (buffer-substring beg (point)))))))
  1581.           (set-syntax-table orig-syntax-table)
  1582.           name))))
  1583.  
  1584. ;;; Find function name that point is in
  1585. ;;; (trick is to start from the end)
  1586. ;;;
  1587. (defun fume-function-before-point ()
  1588.   (if (or fume-modeline-funclist (fume-rescan-buffer) fume-modeline-funclist)
  1589.       (let ((p (point)))
  1590.         (save-excursion
  1591.           (catch 'found
  1592.             (mapcar (function
  1593.                      (lambda (x)
  1594.                        (goto-char (cdr x))
  1595.                        (beginning-of-line 1)
  1596.                        (if (>= p (point)) (throw 'found (car x)))))
  1597.                     fume-modeline-funclist) nil)))))
  1598.  
  1599. ;;; Routines to add a buffer local post command hook
  1600. ;;;
  1601. (defun fume-post-command-hook-p (hook)
  1602.   (memq hook (if fume-use-local-post-command-hook
  1603.                  local-post-command-hook
  1604.                post-command-hook)))
  1605.  
  1606. (defun fume-add-post-command-hook (hook &optional append)
  1607.   (or (fume-post-command-hook-p hook)
  1608.       (cond (fume-use-local-post-command-hook
  1609.              (add-hook 'local-post-command-hook hook append))
  1610.             ((fboundp 'make-local-hook)
  1611.              (make-local-hook 'post-command-hook)
  1612.              (add-hook 'post-command-hook hook append t))
  1613.             (t
  1614.              ;; NOT make-variable-buffer-local
  1615.              (make-local-variable 'post-command-hook)
  1616.              (add-hook 'post-command-hook hook append)))))
  1617.  
  1618. (defun fume-remove-post-command-hook (hook)
  1619.   (and (fume-post-command-hook-p hook)
  1620.        (cond (fume-use-local-post-command-hook
  1621.               (remove-hook 'local-post-command-hook hook))
  1622.              ((fboundp 'make-local-hook)
  1623.               (remove-hook 'post-command-hook hook t))
  1624.              (t
  1625.               (remove-hook 'post-command-hook hook)))))
  1626.  
  1627. ;;; Routine to install the modeline feature
  1628. ;;;
  1629. (defun fume-maybe-install-modeline-feature ()
  1630.   (cond ((and fume-display-in-modeline-p (fume-set-defaults))
  1631.          (or fume-modeline-funclist
  1632.              (fume-post-command-hook-p 'fume-tickle-modeline)
  1633.              (fume-rescan-buffer))
  1634.          (fume-add-post-command-hook 'fume-tickle-modeline)
  1635.          (fume-remove-post-command-hook 'fume-maybe-install-modeline-feature)
  1636.          (fume-tickle-modeline-1)
  1637.          (fume-tickle-modeline)
  1638.          t                              ; return success flag
  1639.          )))
  1640.  
  1641. (defun fume-toggle-modeline-display ()
  1642.   "Toggles whether func-menu displays function names in the modeline"
  1643.   (interactive)
  1644.   (setq fume-display-in-modeline-p (not fume-display-in-modeline-p))
  1645.   (if (interactive-p) (fume-tickle-modeline)))
  1646.  
  1647. ;;; Routine to display function before point in the modeline
  1648. ;;;
  1649. (defun fume-tickle-modeline ()
  1650.   (let ((fname (and fume-display-in-modeline-p (fume-function-before-point))))
  1651.     (set fume-modeline-buffer-identification
  1652.          (cond ((and fume-display-in-modeline-p (not (null fname)))
  1653.                 (setq fname (format "`%s'" (fume-trim-string fname)))
  1654.                 (if (eq fume-display-in-modeline-p t)
  1655.                     (list fume-modeline-buffer-identification-1 " " fname)
  1656.                   fname))
  1657.                (t
  1658.                 fume-modeline-buffer-identification-0))))
  1659.   (cond ((not fume-display-in-modeline-p)
  1660.          (fume-remove-post-command-hook 'fume-tickle-modeline)
  1661.          (fume-add-post-command-hook 'fume-maybe-install-modeline-feature)))
  1662.   ;; force update of the modeline
  1663.   (redraw-modeline))
  1664.  
  1665. (fume-defvar-local fume-modeline-buffer-identification-0 nil
  1666.   "Storage for original modeline-buffer-identification")
  1667.  
  1668. (fume-defvar-local fume-modeline-buffer-identification-1 nil
  1669.   "Storage for munged modeline-buffer-identification")
  1670.  
  1671. (defun fume-tickle-f-to-b (str)
  1672.   ;; Change modeline format of "XEmacs: %f" to "XEmacs: %b" in order to make
  1673.   ;; extra room for the function name which is going to be appended to the
  1674.   ;; modeline-buffer-identification component of the modeline-format.
  1675.   (cond ((consp str)
  1676.          (if (extentp (car str))
  1677.              (cons (car str)
  1678.                    (fume-tickle-f-to-b (cdr str)))
  1679.            (mapcar (function fume-tickle-f-to-b) str)))
  1680.         ((not (stringp str))
  1681.          str)
  1682.         ((string-match "%[0-9]*f" str)
  1683.          (let ((newstr (copy-sequence str)))
  1684.            (aset newstr (1- (match-end 0)) (string-to-char "b"))
  1685.            newstr))
  1686.         (t str)))
  1687.  
  1688. (defun fume-tickle-modeline-1 ()
  1689.   (or fume-modeline-buffer-identification-0
  1690.       (setq fume-modeline-buffer-identification-0
  1691.             (symbol-value fume-modeline-buffer-identification)))
  1692.   (setq fume-modeline-buffer-identification-1
  1693.         (fume-tickle-f-to-b fume-modeline-buffer-identification-0)))
  1694.  
  1695. ;;; Routine to toggle auto recanning of the buffer
  1696. (defun fume-toggle-auto-rescanning ()
  1697.   (interactive)
  1698.   (message "Func-Menu buffer auto-rescanning turned %s"
  1699.            (if (setq fume-auto-rescan-buffer-p (not fume-auto-rescan-buffer-p))
  1700.                "ON" "OFF"))
  1701.   (sit-for 0))
  1702.  
  1703. ;;; Routine to create a shallow separate copy of a list
  1704. ;;;
  1705. (if (fboundp 'copy-tree)                ; not built-in in all emacsen
  1706.     (defalias 'fume-shallow-copy-list 'copy-tree)
  1707.   (defun fume-shallow-copy-list (list)
  1708.     (mapcar (function (lambda (i) (cons (car i) (cdr i)))) list)))
  1709.  
  1710. ;;; Sort function to sort items depending on their function-name
  1711. ;;; An item looks like (NAME . POSITION).
  1712. ;;;
  1713. (defun fume-sort-by-name (item1 item2)
  1714.   (or (string-lessp (car item1) (car item2))
  1715.       (string-equal (car item1) (car item2))))
  1716.  
  1717. ;;; Sort function to sort items depending on their position
  1718. ;;;
  1719. (defun fume-sort-by-position (item1 item2)
  1720.   (<= (cdr item1) (cdr item2)))
  1721.  
  1722. ;;; Support function to calculate relative position in buffer
  1723. ;;;
  1724. (defun fume-relative-position ()
  1725.   (let ((pos (point))
  1726.         (total (buffer-size)))
  1727.     (if (> total 50000)
  1728.         ;; Avoid overflow from multiplying by 100!
  1729.         (/ (1- pos) (max (/ total 100) 1))
  1730.       (/ (* 100 (1- pos))
  1731.          (max total 1)))))
  1732.  
  1733. ;;; Split LIST into sublists of max length N
  1734. ;;; Example (fume-split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
  1735. ;;;
  1736. (defun fume-split (list n)
  1737.   (let ((i 0)
  1738.         result
  1739.         sublist
  1740.         (remain list))
  1741.     (while remain
  1742.       (if (= n (setq sublist (cons (car remain) sublist)
  1743.                      remain (cdr remain)
  1744.                      i (1+ i)))
  1745.           ;; We have finished a sublist
  1746.           (setq result (cons (nreverse sublist) result)
  1747.                 sublist nil
  1748.                 i 0)))
  1749.     ;; There might be a sublist (if the length of LIST mod n is != 0)
  1750.     ;; that has to be added to the result list.
  1751.     (if sublist
  1752.         (setq result (cons (nreverse sublist) result)))
  1753.     (nreverse result)))
  1754.  
  1755. ;;; Routines to create indexes for submenus
  1756. ;;;
  1757.  
  1758. ;;; Method 0
  1759. ;;;
  1760. (defun fume-index-sublist-method-0 (sublist count)
  1761.   (concat "Function sublist #" count))
  1762.  
  1763. ;;; Method 1
  1764. ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
  1765. ;;;
  1766. (defun fume-index-sublist-method-1 (sublist &rest count)
  1767.   (interactive)
  1768.   (let ((s (substring (car (car sublist)) 0 1))
  1769.         (e (substring (car (nth (1- (length sublist)) sublist)) 0 1)))
  1770.     (format "Function sublist (%s%s)"
  1771.             s (if (string-equal s e) "<>" (format "<>-%s<>" e)))))
  1772.  
  1773. ;;; Method 2
  1774. ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
  1775. ;;;
  1776. (defun fume-index-sublist-method-2 (sublist &rest count)
  1777.   (let ((s (substring (car (car sublist))
  1778.                       0
  1779.                       (min (length (car (car sublist))) 12)))
  1780.         (e (substring (car (nth (1- (length sublist)) sublist))
  1781.                       0
  1782.                       (min (length (car (nth (1- (length sublist)) sublist)))
  1783.                            12))))
  1784.     (format "%s%s" s (if (string-equal s e) "<>" (format "<> ... %s<>" e)))))
  1785.  
  1786. ;;; Method 3
  1787. ;;;
  1788. (defun fume-index-sublist-method-3-1 (sublist ix limit)
  1789.   (let ((s1 (substring (car (car sublist)) 0 (min limit ix)))
  1790.         (s2 (substring
  1791.              (car (nth (1- (length sublist)) sublist))
  1792.              0 (min (length (car (nth (1- (length sublist)) sublist))) ix))))
  1793.     (cons s1 s2)))
  1794.  
  1795. (defun fume-index-sublist-method-3 (sublist &rest count)
  1796.   (let* ((cmplength 12)
  1797.          (limit (length (car (car sublist))))
  1798.          (result (fume-index-sublist-method-3-1 sublist cmplength limit))
  1799.          (str1 (car result))
  1800.          (str2 (cdr result)))
  1801.     (while (and (string-equal str1 str2) (< cmplength limit))
  1802.       (setq cmplength (1+ cmplength)
  1803.             result (fume-index-sublist-method-3-1 sublist cmplength limit)
  1804.             str1 (car result)
  1805.             str2 (cdr result)))
  1806.     (cond ((not (string-equal str1 str2))
  1807.            (format "%s<> ... %s<>" str1 str2))
  1808.           ((< cmplength limit)
  1809.            (format "%s<>" str1))
  1810.           (t
  1811.            (format "%s ..." str1)))))
  1812.  
  1813. ;;; Buffer rescanning
  1814. ;;;
  1815. (defun fume-rescan-buffer-trigger ()
  1816.   "Automatically spots when a buffer rescan becomes necessary"
  1817.   (if fume-auto-rescan-buffer-p
  1818.       (if (> fume-rescan-trigger-counter 0)
  1819.           (setq fume-rescan-trigger-counter (1- fume-rescan-trigger-counter))
  1820.         (setq fume-rescan-trigger-counter
  1821.           (max fume-rescan-trigger-counter-min
  1822.               (/ (buffer-size) fume-rescan-trigger-counter-buffer-size)))
  1823.         (if (or fume-funclist-dirty-p
  1824.                 (save-excursion
  1825.                   (let (find fnam)
  1826.                     (condition-case ()
  1827.                         (and fume-function-name-regexp
  1828.                              (setq fnam (fume-function-before-point))
  1829.                              (setq find (symbol-value
  1830.                                          'fume-find-next-function-name-method))
  1831.                              (progn (end-of-line 1)
  1832.                                     (re-search-backward
  1833.                                      fume-function-name-regexp nil t))
  1834.                              (if (eq find 'fume-find-next-latex-section-name)
  1835.                                  (let ((lnam
  1836.                                         (car (fume-find-next-latex-section-name
  1837.                                               (current-buffer)))))
  1838.                                    (fume-tex-rescan-buffer-hook)
  1839.                                    (not (string-equal
  1840.                                          (substring fnam
  1841.                                                     (string-match " " fnam))
  1842.                                          (substring lnam
  1843.                                                     (string-match " " lnam)))))
  1844.                                (not (string-equal
  1845.                                      fnam
  1846.                                      (car (funcall find (current-buffer)))))))
  1847.                       (error nil)))))
  1848.             (let ((fume-scanning-message nil))
  1849.               (fume-rescan-buffer))))))
  1850.  
  1851. (defun fume-install-rescan-buffer-trigger ()
  1852.   (cond ((not (fume-post-command-hook-p 'fume-rescan-buffer-trigger))
  1853.          (fume-add-post-command-hook 'fume-rescan-buffer-trigger 'append)
  1854.          ;; Make narrow-to-region tickle func-menu
  1855.          (or (fboundp 'fume-narrow-to-region)
  1856.              (fset 'fume-narrow-to-region
  1857.                    (symbol-function 'narrow-to-region)))
  1858.          (defun narrow-to-region (b e)
  1859.            "Restrict editing in this buffer to the current region.
  1860. The rest of the text becomes temporarily invisible and untouchable
  1861. but is not deleted; if you save the buffer in a file, the invisible
  1862. text is included in the file.  C-x n w makes all visible again.
  1863. See also `save-restriction'.
  1864.  
  1865. When calling from a program, pass two arguments; positions (integers
  1866. or markers) bounding the text that should remain visible"
  1867.            (interactive "r")
  1868.            (fume-narrow-to-region b e)
  1869.            (if fume-funclist (setq fume-funclist-dirty-p t)))
  1870.          ;; Make widen tickle func-menu
  1871.          (or (fboundp 'fume-widen)
  1872.              (fset 'fume-widen (symbol-function 'widen)))
  1873.          (defun widen ()
  1874.            "Remove restrictions (narrowing) from current buffer.
  1875. This allows the buffer's full text to be seen and edited."
  1876.            (interactive)
  1877.            (fume-widen)
  1878.            (if fume-funclist (setq fume-funclist-dirty-p t))))))
  1879.  
  1880. (defun fume-rescan-buffer (&optional popmenu)
  1881.   "Rescans the buffer for function names.
  1882. If optional arg POPMENU is non-nil, brings up the function-menu."
  1883.   (interactive)
  1884.   (let ((find (symbol-value 'fume-find-next-function-name-method))
  1885.         (fnam)
  1886.         (flst '())
  1887.         (buffer-to-scan (current-buffer)))
  1888.     (save-excursion
  1889.       (goto-char (point-min))
  1890.       (cond (fume-scanning-message
  1891.              (display-message 'progress (format fume-scanning-message 0)))
  1892.             (fume-rescanning-message
  1893.              (display-message 'progress fume-rescanning-message)))
  1894.       (while (setq fnam
  1895.                    (condition-case ()
  1896.                        (funcall find buffer-to-scan)
  1897.                      (error
  1898.                       ;; test for more possible fns after this error trap
  1899.                       (if (consp fume-function-name-regexp)
  1900.                (save-excursion
  1901.                  (re-search-forward
  1902.                   (car fume-function-name-regexp) nil t))
  1903.              (and fume-function-name-regexp
  1904.                   (save-excursion
  1905.                     (re-search-forward
  1906.                  fume-function-name-regexp nil t)))))))
  1907.         (cond ((listp fnam)
  1908.                (setq flst (cons fnam flst))
  1909.                (if fume-found-function-hook
  1910.                    (save-excursion (run-hooks 'fume-found-function-hook)))))
  1911.         (if fume-scanning-message
  1912.             (display-message 'progress (format fume-scanning-message (fume-relative-position)))))
  1913.       (cond (fume-scanning-message
  1914.              (display-message 'progress (format "%s done" (format fume-scanning-message 100))))
  1915.             (fume-rescanning-message
  1916.              (display-message 'progress (format "%s done" fume-rescanning-message))))
  1917.       ;; make a copy of flst sorted by position in buffer
  1918.       (setq fume-modeline-funclist
  1919.             (nreverse
  1920.              (sort (fume-shallow-copy-list flst) 'fume-sort-by-position)))
  1921.       (if fume-sort-function
  1922.           (setq fume-funclist (sort flst fume-sort-function))
  1923.         (setq fume-funclist (nreverse flst)))
  1924.       (if fume-rescan-buffer-hook
  1925.           (run-hooks 'fume-rescan-buffer-hook))))
  1926.   (if popmenu
  1927.       (function-menu)
  1928.     (let ((fume-rescan-inhibit-p t))
  1929.       (fume-update-menubar-entry)))
  1930.   ;; Reset dirty flag
  1931.   (setq fume-funclist-dirty-p nil))
  1932.  
  1933. (defun fume-scan-buffer ()
  1934.   (or fume-funclist (progn (fume-set-defaults) (fume-rescan-buffer))))
  1935.  
  1936. ;;; Routine to position cursor
  1937. ;;;
  1938. (defun fume-goto-function (fn pos)
  1939.   "Position cursor at function FN at location POS"
  1940.   (let ((orig-pos (point))
  1941.         (case-fold-search nil)
  1942.         (match-fn (cond ((string-match "DEFUN " fn) ; Emacs DEFUN declaration
  1943.                          (substring fn (match-end 0)))
  1944.                         ((string-match "^[ \t]*" fn) ; strip leading spaces
  1945.                          (substring fn (match-end 0)))
  1946.                         (t
  1947.                          fn))))
  1948.  
  1949.     (save-excursion
  1950.       (goto-char pos)
  1951.       (or (looking-at (regexp-quote match-fn))
  1952.           (let ((fume-scanning-message nil))
  1953.             (fume-rescan-buffer)
  1954.             (setq pos (cdr-safe (assoc fn fume-funclist))))))
  1955.  
  1956.     (if pos
  1957.         (progn
  1958.           (goto-char pos)
  1959.           ;; possibly set mark
  1960.           (or (= orig-pos (point))
  1961.               (push-mark orig-pos (null fume-scanning-message)))
  1962.           (if (numberp fume-fn-window-position)
  1963.               (set-window-start
  1964.                (selected-window)
  1965.                (save-excursion
  1966.                  (beginning-of-line
  1967.                   (- 1 (min (- (window-height) 2) fume-fn-window-position)))
  1968.                  (point)))
  1969.             (recenter)))
  1970.       (ding)
  1971.       (message "%s not found" fn)
  1972.       (function-menu))))
  1973.  
  1974. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1975. ;;;;;;;;;;;;;;;;;;  The main entry points for this package  ;;;;;;;;;;;;;;;;
  1976. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1977.  
  1978. ;;; Interface to function-menu for mouse bindings only
  1979. ;;;
  1980. (defun mouse-function-menu (event)
  1981.   "Wrapper for mouse button bindings for function-menu"
  1982.   (interactive "e")
  1983.   (let ((currwin (selected-window)))
  1984.     (condition-case ()
  1985.         (progn
  1986.           (select-window (fume-event-window event))
  1987.           (let ((fume-auto-position-popup nil))
  1988.             (call-interactively 'function-menu)))
  1989.       (error (select-window currwin)))))
  1990.  
  1991. ;;; Interface for Key bindings
  1992. ;;;
  1993. (defun function-menu (&optional use-menubar return-only)
  1994.   "Pop up a menu of functions for selection with the mouse.
  1995. Jumps to the selected function.  A mark is set at the old position,
  1996. so you can easily go back with C-u \\[set-mark-command].
  1997.  
  1998. With a prefix arg adds the menu to the current menubar.
  1999. Optional second argument, RETURN-ONLY if non-nil simply returns
  2000. the basic menu of functions."
  2001.   (interactive "P")
  2002.  
  2003.   (setq use-menubar
  2004.         (and use-menubar fume-running-xemacs fume-not-tty current-menubar))
  2005.  
  2006.   (catch 'no-functions
  2007.     (or (fume-set-defaults)
  2008.         (if (not (interactive-p))
  2009.             (throw 'no-functions t)
  2010.           (error "func-menu does not support the mode \"%s\"" mode-name)))
  2011.  
  2012.     ;; Create a list for this buffer only if there isn't any.
  2013.     (or fume-funclist
  2014.         (if fume-rescan-inhibit-p
  2015.             (fume-remove-menubar-entry)
  2016.           (fume-rescan-buffer)))
  2017.     (or fume-funclist
  2018.         (if (not (interactive-p))
  2019.             (throw 'no-functions t)
  2020.           (error "No functions found in this buffer.")))
  2021.  
  2022.     ;; Rescan buffer trigger
  2023.     (fume-install-rescan-buffer-trigger)
  2024.  
  2025.     ;; Function name in modeline
  2026.     (fume-maybe-install-modeline-feature)
  2027.  
  2028.     ;; The rest of this routine works only for (Lucid) XEmacs
  2029.     (cond (fume-running-xemacs
  2030.            ;; Create the menu
  2031.            (let* ((count 0)
  2032.                   (index-method
  2033.                    (intern (format "fume-index-sublist-method-%d"
  2034.                                    fume-index-method)))
  2035.                   function-menu
  2036.                   (function-menu-items
  2037.                    (mapcar
  2038.                     (function
  2039.                      (lambda (sublist)
  2040.                        (setq count (1+ count))
  2041.                        (cons (format "%s"
  2042.                                      (funcall index-method sublist count))
  2043.                              (mapcar
  2044.                               (function
  2045.                                (lambda (menu)
  2046.                                  (vector (format "%s" (car menu))
  2047.                                          (list 'fume-goto-function
  2048.                                                (car menu) (cdr menu))
  2049.                                          t)))
  2050.                               sublist))))
  2051.                     (fume-split fume-funclist fume-max-items))))
  2052.  
  2053.              (or (> count 1)
  2054.                  (setq function-menu-items (cdr (car function-menu-items))))
  2055.  
  2056.              (if return-only
  2057.                  nil
  2058.                (setq function-menu
  2059.                      (` ((,@ function-menu-items)
  2060.                          "----"
  2061.                          ["Display full list of functions"
  2062.                           fume-list-functions t]
  2063.                          [(, (concat "Rescan buffer :  " (buffer-name)))
  2064.                           (fume-rescan-buffer (, (null use-menubar))) t]
  2065.                          "----"
  2066.                          ["Toggle modeline display"
  2067.                           fume-toggle-modeline-display t]
  2068.                          ["Toggle buffer auto rescanning"
  2069.                           fume-toggle-auto-rescanning t]
  2070.                          ["About Func-Menu" fume-about t])))
  2071.  
  2072.                (cond (use-menubar
  2073.                       (fume-remove-menubar-entry)
  2074.                       (set-buffer-menubar (copy-sequence current-menubar))
  2075.                       (fume-add-submenu
  2076.                        fume-menubar-menu-name
  2077.                        (` ((,@ function-menu)
  2078.                            "----"
  2079.                            ["Remove Function Menu from menubar"
  2080.                             fume-remove-menubar-entry t]))
  2081.                        fume-menubar-menu-location))
  2082.  
  2083.                      ((and fume-not-tty ; trap tty segmentation faults...
  2084.                            (not (popup-up-p)))
  2085.                       (or (fume-update-menubar-entry)
  2086.                           (setq function-menu
  2087.                                 (cons
  2088.                                  ["Put Function Menu into menubar"
  2089.                                   (function-menu t) t]
  2090.                                  (cons "----" function-menu))))
  2091.  
  2092.                       (if fume-auto-position-popup
  2093.                           (fume-set-mouse-position))
  2094.  
  2095.                       (popup-menu
  2096.                        (cons fume-menubar-menu-name function-menu)))))
  2097.  
  2098.              ;; Return basic function menu for display by another function
  2099.              function-menu-items)))))
  2100.  
  2101. (defun fume-mouse-function-goto (event)
  2102.   "Goto function clicked on or prompt in minibuffer (with completion)."
  2103.   (interactive "@e")
  2104.   (let ((orig-pos (point)))
  2105.     (goto-char (event-point event))
  2106.     (let ((fume-no-prompt-on-valid-default t))
  2107.       (fume-prompt-function-goto))
  2108.     (or (= orig-pos (point))
  2109.         (push-mark orig-pos (null fume-scanning-message)))))
  2110.  
  2111. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2112. ;;;;;;;;;;;;;;;;  Keyboard access to func-menu for tty users  ;;;;;;;;;;;;;;
  2113. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2114.  
  2115. ;;; Internal variables only
  2116. ;;;
  2117. (defvar fume-list-srcbuffer nil)
  2118. (defvar fume-list-reused-win-p nil)
  2119. (defvar fume-list-trampled-buffer nil)
  2120.  
  2121. ;;; Espen Skoglund <espensk@stud.cs.uit.no>
  2122. ;;; David Hughes <d.hughes@videonetworks.com>
  2123. ;;;
  2124. (defun fume-prompt-function-goto (&optional other-window-p)
  2125.   "Goto function prompted for in minibuffer (with completion).
  2126. With prefix arg, jumps to function in a different window."
  2127.   (interactive "P")
  2128.   (let* ((default-name (fume-what-looking-at t))
  2129.          (OrigBuffer (current-buffer))
  2130.          (flistMode (eq major-mode 'fume-list-mode))
  2131.          (no-prompt (or flistMode fume-no-prompt-on-valid-default))
  2132.          (TargetBuffer (if flistMode fume-list-srcbuffer OrigBuffer)))
  2133.     (switch-to-buffer TargetBuffer)
  2134.     (fume-scan-buffer) ;; Create funclist and set defaults if required
  2135.     (let* (;; verify default-name is a valid function name
  2136.            (default-exists-p (assoc default-name fume-funclist))
  2137.            ;; Prompt for function name in minibuffer, unless there is a valid
  2138.            ;; function name at point & fume-no-prompt-on-valid-default set to t
  2139.            (function-name
  2140.             (if (and default-exists-p no-prompt)
  2141.                 ""
  2142.               (let ((this-command last-command)) ; preserve last-command
  2143.                 (completing-read
  2144.                  (format "Goto function%s%s: "
  2145.                          (if other-window-p " other window" "")
  2146.                          (if default-exists-p
  2147.                              (concat " (" default-name ")")
  2148.                            ""))
  2149.                  fume-funclist nil t))))
  2150.            ;; Use default function name if just RET was pressed
  2151.            (function-name (if (and default-exists-p (string= "" function-name))
  2152.                               default-name
  2153.                             function-name)))
  2154.       (switch-to-buffer OrigBuffer)
  2155.       ;; Goto function or just return if function name is empty string
  2156.       (cond ((not (string= "" function-name))
  2157.              (if other-window-p
  2158.                  (cond ((prog1 (one-window-p)
  2159.                           (if (not (windowp other-window-p))
  2160.                               (switch-to-buffer-other-window TargetBuffer)
  2161.                             (select-window other-window-p)
  2162.                             (switch-to-buffer TargetBuffer)))
  2163.                         (other-window 1)
  2164.                         (shrink-window-if-larger-than-buffer)
  2165.                         (other-window 1)))
  2166.                (switch-to-buffer TargetBuffer))
  2167.              (fume-goto-function
  2168.               function-name (cdr (assoc function-name fume-funclist))))))))
  2169.  
  2170. (defun fume-prompt-function-goto-one-window ()
  2171.   (interactive)
  2172.   (delete-other-windows)
  2173.   (fume-prompt-function-goto))
  2174.  
  2175. (defun fume-prompt-function-goto-other-window ()
  2176.   (interactive)
  2177.   (fume-prompt-function-goto t))
  2178.  
  2179. (defun fume-list-functions-show-fn-other-window (&optional window)
  2180.   (interactive)
  2181.   (beginning-of-line)
  2182.   (select-window
  2183.    (prog1 (selected-window) (fume-prompt-function-goto (or window t)))))
  2184.  
  2185. (defun fume-list-functions-show-prev-fn-other-window (&optional window)
  2186.   (interactive)
  2187.   (forward-line -1)
  2188.   (fume-list-functions-show-fn-other-window window))
  2189.  
  2190. (defun fume-list-functions-show-next-fn-other-window (&optional window)
  2191.   (interactive)
  2192.   (forward-line 1)
  2193.   (beginning-of-line)
  2194.   (fume-list-functions-show-fn-other-window window))
  2195.  
  2196. (defun fume-list-functions-help ()
  2197.   (interactive)
  2198.   (fume-about)
  2199.   (sit-for 1)
  2200.   (display-message 'prompt
  2201.            (format "SPC=%s, p=%s, n=%s, o=%s, G=%s, RET=%s,    q=%s"
  2202.                "this"
  2203.                "previous"
  2204.                "next"
  2205.                "other win"
  2206.                "one win"
  2207.                "this win"
  2208.                "quit")))
  2209.  
  2210. (defun fume-list-functions-quit ()
  2211.   (interactive)
  2212.   (if (eq major-mode 'fume-list-mode)
  2213.       (kill-buffer (current-buffer)))
  2214.   (if fume-list-reused-win-p
  2215.       (condition-case ()
  2216.           (switch-to-buffer fume-list-trampled-buffer)
  2217.         (error nil))
  2218.     (or (one-window-p)
  2219.         (delete-window (selected-window))))
  2220.   (if (not (eq (current-buffer) fume-list-srcbuffer))
  2221.       (condition-case ()
  2222.           (select-window (get-buffer-window fume-list-srcbuffer))
  2223.         (error
  2224.          (condition-case ()
  2225.              (switch-to-buffer fume-list-srcbuffer)
  2226.            (error nil))))))
  2227.  
  2228. (defun fume-list-mouse-select (event)
  2229.   (interactive "e")
  2230.   (let (ws cb cp (wc (current-window-configuration)))
  2231.     (mouse-set-point event)
  2232.     (fume-prompt-function-goto-other-window)
  2233.     (setq ws (save-excursion
  2234.                (beginning-of-line (- 1 fume-fn-window-position)) (point))
  2235.           cb (current-buffer)
  2236.           cp (point))
  2237.     (set-window-configuration wc)
  2238.     (switch-to-buffer cb)
  2239.     (set-window-start (selected-window) ws)
  2240.     (goto-char cp)))
  2241.  
  2242. (defvar fume-list-mode-map nil)
  2243. (or fume-list-mode-map
  2244.     (let ((map (make-sparse-keymap)))
  2245.       (define-key map "q"    'fume-list-functions-quit)
  2246.       (define-key map "h"    'fume-list-functions-help)
  2247.       (define-key map "?"    'fume-list-functions-help)
  2248.       (define-key map "g"    'fume-prompt-function-goto)
  2249.       (define-key map "\C-m" 'fume-prompt-function-goto)
  2250.       (define-key map "G"    'fume-prompt-function-goto-one-window)
  2251.       (define-key map "o"    'fume-prompt-function-goto-other-window)
  2252.       (define-key map " "    'fume-list-functions-show-fn-other-window)
  2253.       (define-key map "p"    'fume-list-functions-show-prev-fn-other-window)
  2254.       (define-key map "n"    'fume-list-functions-show-next-fn-other-window)
  2255.       (if fume-not-tty
  2256.           (define-key map [(button2)] 'fume-list-mouse-select))
  2257.       (setq fume-list-mode-map map)))
  2258.  
  2259. (defvar fume-list-mode-hook nil "*Hook to run after fume-list-mode entered")
  2260.  
  2261. (defun fume-list-functions (&optional this-window)
  2262.   "Creates a temporary buffer listing functions found in the current buffer"
  2263.   (interactive "P")
  2264.   (fume-scan-buffer) ;; Create funclist and set defaults if required
  2265.   (let ((func-near-point (format "^%s$" (fume-function-before-point))))
  2266.     (cond ((or fume-function-name-regexp (fume-maybe-install-modeline-feature))
  2267.            (save-excursion
  2268.              (let ((srcbuffer (current-buffer)))
  2269.                (set-buffer (get-buffer-create fume-buffer-name))
  2270.                (let (buffer-read-only) (erase-buffer))
  2271.                (use-local-map fume-list-mode-map)
  2272.                (setq buffer-read-only t
  2273.                      mode-name "Func-Menu"
  2274.                      major-mode 'fume-list-mode
  2275.                      fume-list-srcbuffer srcbuffer
  2276.                      fume-list-reused-win-p (not (one-window-p)))
  2277.                (if fume-not-tty
  2278.                    (setq mode-motion-hook 'mode-motion-highlight-symbol))
  2279.                (run-hooks 'fume-list-mode-hook)))
  2280.            (or fume-funclist (fume-rescan-buffer))
  2281.            (if fume-funclist
  2282.                (mapcar (function
  2283.                         (lambda (p)
  2284.                           (save-excursion
  2285.                             (set-buffer fume-buffer-name)
  2286.                             (let (buffer-read-only)
  2287.                               (goto-char (point-max))
  2288.                               (if (= (point-min) (point))
  2289.                                   (insert (car p))
  2290.                                 (insert (concat "\n" (car p))))
  2291.                               (set-buffer-modified-p nil)
  2292.                               (goto-char (point-min))))))
  2293.                        fume-funclist))
  2294.            (cond ((interactive-p)
  2295.                   (if current-prefix-arg
  2296.                       (switch-to-buffer fume-buffer-name)
  2297.                     (switch-to-buffer-other-window fume-buffer-name)
  2298.                     (setq fume-list-trampled-buffer (other-buffer))
  2299.                     (or fume-list-reused-win-p
  2300.                         (shrink-window-if-larger-than-buffer)))
  2301.                   (cond (func-near-point
  2302.                          (re-search-forward func-near-point nil t)
  2303.                          (beginning-of-line)))
  2304.                   (fume-list-functions-help))))
  2305.           (t
  2306.            (error "Func-Menu is not operative in this buffer")))))
  2307.  
  2308. (provide 'func-menu)
  2309.  
  2310. ;;; end of file
  2311.